mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-24 04:51:32 +02:00
* changed to class with common TAssembler also for internal assembler
This commit is contained in:
peter
parent
3eb9c758fb
commit
1b1f938c43
@ -40,8 +40,7 @@ const
|
||||
AsmOutSize=32768;
|
||||
|
||||
type
|
||||
PAsmList=^TAsmList;
|
||||
TAsmList=object
|
||||
TAssembler=class
|
||||
private
|
||||
procedure CreateSmartLinkPath(const s:string);
|
||||
public
|
||||
@ -49,25 +48,30 @@ type
|
||||
path : pathstr;
|
||||
name : namestr;
|
||||
asmfile, { current .s and .o file }
|
||||
objfile,
|
||||
as_bin : string;
|
||||
objfile : string;
|
||||
SmartAsm : boolean;
|
||||
SmartFilesCount,
|
||||
SmartHeaderCount : longint;
|
||||
place : TCutPlace; { special 'end' file for import dir ? }
|
||||
Constructor Create(smart:boolean);
|
||||
Destructor Destroy;override;
|
||||
procedure WriteTree(p:TAAsmoutput);virtual;
|
||||
procedure WriteAsmList;virtual;
|
||||
procedure NextSmartName(place:tcutplace);
|
||||
end;
|
||||
|
||||
TExternalAssembler=class(TAssembler)
|
||||
protected
|
||||
{outfile}
|
||||
AsmSize,
|
||||
AsmStartSize,
|
||||
outcnt : longint;
|
||||
outbuf : array[0..AsmOutSize-1] of char;
|
||||
outfile : file;
|
||||
Constructor Init(smart:boolean);
|
||||
Destructor Done;
|
||||
public
|
||||
Function FindAssembler:string;
|
||||
Function CallAssembler(const command,para:string):Boolean;
|
||||
Function DoAssemble:boolean;
|
||||
Procedure RemoveAsm;
|
||||
procedure NextSmartName;
|
||||
Procedure AsmFlush;
|
||||
Procedure AsmClear;
|
||||
Procedure AsmWrite(const s:string);
|
||||
@ -77,8 +81,8 @@ type
|
||||
procedure AsmCreate(Aplace:tcutplace);
|
||||
procedure AsmClose;
|
||||
procedure Synchronize;
|
||||
procedure WriteTree(p:TAAsmoutput);virtual;
|
||||
procedure WriteAsmList;virtual;
|
||||
public
|
||||
Constructor Create(smart:boolean);
|
||||
end;
|
||||
|
||||
|
||||
@ -132,309 +136,47 @@ uses
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TAsmList
|
||||
TAssembler
|
||||
*****************************************************************************}
|
||||
|
||||
Function DoPipe:boolean;
|
||||
Constructor TAssembler.Create(smart: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;
|
||||
|
||||
|
||||
const
|
||||
lastas : byte=255;
|
||||
var
|
||||
LastASBin : pathstr;
|
||||
Function TAsmList.FindAssembler:string;
|
||||
var
|
||||
asfound : boolean;
|
||||
UtilExe : string;
|
||||
begin
|
||||
asfound:=false;
|
||||
UtilExe:=AddExtension(target_asm.asmbin,source_os.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 TAsmList.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 TAsmList.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 TAsmList.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 TAsmList.NextSmartName;
|
||||
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;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TAsmList AsmFile Writing
|
||||
*****************************************************************************}
|
||||
|
||||
Procedure TAsmList.AsmFlush;
|
||||
begin
|
||||
if outcnt>0 then
|
||||
begin
|
||||
BlockWrite(outfile,outbuf,outcnt);
|
||||
outcnt:=0;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmList.AsmClear;
|
||||
begin
|
||||
outcnt:=0;
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmList.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 TAsmList.AsmWriteLn(const s:string);
|
||||
begin
|
||||
AsmWrite(s);
|
||||
AsmLn;
|
||||
end;
|
||||
|
||||
|
||||
Procedure TAsmList.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 TAsmList.AsmLn;
|
||||
begin
|
||||
if OutCnt>=AsmOutSize-2 then
|
||||
AsmFlush;
|
||||
OutBuf[OutCnt]:=target_os.newline[1];
|
||||
inc(OutCnt);
|
||||
inc(AsmSize);
|
||||
if length(target_os.newline)>1 then
|
||||
begin
|
||||
OutBuf[OutCnt]:=target_os.newline[2];
|
||||
inc(OutCnt);
|
||||
inc(AsmSize);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TAsmList.AsmCreate(Aplace:tcutplace);
|
||||
begin
|
||||
place:=Aplace;
|
||||
{ load start values }
|
||||
asmfile:=current_module.asmfilename^;
|
||||
objfile:=current_module.objfilename^;
|
||||
name:=FixFileName(current_module.modulename^);
|
||||
SmartAsm:=smart;
|
||||
SmartFilesCount:=0;
|
||||
SmartHeaderCount:=0;
|
||||
SmartLinkOFiles.Clear;
|
||||
{ Which path will be used ? }
|
||||
if SmartAsm then
|
||||
NextSmartName;
|
||||
{$ifdef unix}
|
||||
if DoPipe then
|
||||
begin
|
||||
Message1(exec_i_assembling_pipe,asmfile);
|
||||
POpen(outfile,'as -o '+objfile,'W');
|
||||
path:=current_module.outputpath^+FixFileName(current_module.modulename^)+target_info.smartext;
|
||||
CreateSmartLinkPath(path);
|
||||
path:=FixPath(path,false);
|
||||
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;
|
||||
path:=current_module.outputpath^;
|
||||
end;
|
||||
|
||||
|
||||
procedure TAsmList.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;
|
||||
|
||||
|
||||
{Touch Assembler and object time to ppu time is there is a ppufilename}
|
||||
procedure TAsmList.Synchronize;
|
||||
begin
|
||||
{Touch Assembler time to ppu time is there is a ppufilename}
|
||||
if Assigned(current_module.ppufilename) then
|
||||
begin
|
||||
SynchronizeFileTime(current_module.ppufilename^,asmfile);
|
||||
if not(cs_asm_extern in aktglobalswitches) then
|
||||
SynchronizeFileTime(current_module.ppufilename^,objfile);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TAsmList.WriteTree(p:TAAsmoutput);
|
||||
Destructor TAssembler.Destroy;
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TAsmList.WriteAsmList;
|
||||
procedure TAssembler.WriteTree(p:TAAsmoutput);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TAsmList.CreateSmartLinkPath(const s:string);
|
||||
procedure TAssembler.WriteAsmList;
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TAssembler.CreateSmartLinkPath(const s:string);
|
||||
var
|
||||
dir : searchrec;
|
||||
begin
|
||||
@ -468,32 +210,298 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Constructor TAsmList.Init(smart:boolean);
|
||||
procedure TAssembler.NextSmartName(place:tcutplace);
|
||||
var
|
||||
s : string;
|
||||
begin
|
||||
{ load start values }
|
||||
asmfile:=current_module.asmfilename^;
|
||||
objfile:=current_module.objfilename^;
|
||||
name:=FixFileName(current_module.modulename^);
|
||||
OutCnt:=0;
|
||||
SmartFilesCount:=0;
|
||||
SmartLinkOFiles.Clear;
|
||||
place:=cut_normal;
|
||||
SmartAsm:=smart;
|
||||
SmartHeaderCount:=0;
|
||||
{ Which path will be used ? }
|
||||
if SmartAsm then
|
||||
begin
|
||||
path:=current_module.outputpath^+FixFileName(current_module.modulename^)+target_info.smartext;
|
||||
CreateSmartLinkPath(path);
|
||||
path:=FixPath(path,false);
|
||||
end
|
||||
else
|
||||
path:=current_module.outputpath^;
|
||||
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;
|
||||
|
||||
|
||||
Destructor TAsmList.Done;
|
||||
{*****************************************************************************
|
||||
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);
|
||||
Outcnt:=0;
|
||||
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_os.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_os.newline[1];
|
||||
inc(OutCnt);
|
||||
inc(AsmSize);
|
||||
if length(target_os.newline)>1 then
|
||||
begin
|
||||
OutBuf[OutCnt]:=target_os.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;
|
||||
|
||||
|
||||
{Touch Assembler and object time to ppu time is there is a ppufilename}
|
||||
procedure TExternalAssembler.Synchronize;
|
||||
begin
|
||||
{Touch Assembler time to ppu time is there is a ppufilename}
|
||||
if Assigned(current_module.ppufilename) then
|
||||
begin
|
||||
SynchronizeFileTime(current_module.ppufilename^,asmfile);
|
||||
if not(cs_asm_extern in aktglobalswitches) then
|
||||
SynchronizeFileTime(current_module.ppufilename^,objfile);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -503,10 +511,10 @@ end;
|
||||
|
||||
Procedure GenerateAsm(smart:boolean);
|
||||
var
|
||||
a : PAsmList;
|
||||
a : TExternalAssembler;
|
||||
{$ifdef i386}
|
||||
{$ifndef NoAg386Bin}
|
||||
b : Pi386binasmlist;
|
||||
b : TInternalAssembler;
|
||||
{$endif}
|
||||
{$endif}
|
||||
begin
|
||||
@ -521,16 +529,16 @@ begin
|
||||
begin
|
||||
case aktoutputformat of
|
||||
as_i386_dbg :
|
||||
b:=new(pi386binasmlist,Init(og_dbg,smart));
|
||||
b:=TInternalAssembler.Create(og_dbg,smart);
|
||||
as_i386_coff :
|
||||
b:=new(pi386binasmlist,Init(og_coff,smart));
|
||||
b:=TInternalAssembler.Create(og_coff,smart);
|
||||
as_i386_pecoff :
|
||||
b:=new(pi386binasmlist,Init(og_pecoff,smart));
|
||||
b:=TInternalAssembler.Create(og_pecoff,smart);
|
||||
as_i386_elf :
|
||||
b:=new(pi386binasmlist,Init(og_elf,smart));
|
||||
b:=TInternalAssembler.Create(og_elf,smart);
|
||||
end;
|
||||
b^.WriteBin;
|
||||
dispose(b,done);
|
||||
b.WriteBin;
|
||||
b.Free;
|
||||
if assigned(current_module.ppufilename) then
|
||||
begin
|
||||
if smart then
|
||||
@ -545,19 +553,19 @@ begin
|
||||
as_i386_as,
|
||||
as_i386_as_aout,
|
||||
as_i386_asw :
|
||||
a:=new(pi386attasmlist,Init(smart));
|
||||
a:=T386ATTAssembler.create(smart);
|
||||
{$endif NoAg386Att}
|
||||
{$ifndef NoAg386Nsm}
|
||||
as_i386_nasmcoff,
|
||||
as_i386_nasmwin32,
|
||||
as_i386_nasmelf,
|
||||
as_i386_nasmobj :
|
||||
a:=new(pi386nasmasmlist,Init(smart));
|
||||
a:=T386NasmAssembler.Create(smart);
|
||||
{$endif NoAg386Nsm}
|
||||
{$ifndef NoAg386Int}
|
||||
as_i386_masm,
|
||||
as_i386_tasm :
|
||||
a:=new(pi386intasmlist,Init(smart));
|
||||
a:=T386IntelAssembler.Create(smart);
|
||||
{$endif NoAg386Int}
|
||||
{$endif}
|
||||
{$ifdef m68k}
|
||||
@ -568,11 +576,11 @@ begin
|
||||
{$endif NoAg86KGas}
|
||||
{$ifndef NoAg68kMot}
|
||||
as_m68k_mot :
|
||||
a:=new(pm68kmotasmlist,Init(smart));
|
||||
a:=new(pm68kmoTExternalAssembler,Init(smart));
|
||||
{$endif NoAg86kMot}
|
||||
{$ifndef NoAg68kMit}
|
||||
as_m68k_mit :
|
||||
a:=new(pm68kmitasmlist,Init(smart));
|
||||
a:=new(pm68kmiTExternalAssembler,Init(smart));
|
||||
{$endif NoAg86KMot}
|
||||
{$ifndef NoAg68kMpw}
|
||||
as_m68k_mpw :
|
||||
@ -582,28 +590,31 @@ begin
|
||||
else
|
||||
Message(asmw_f_assembler_output_not_supported);
|
||||
end;
|
||||
a^.AsmCreate(cut_normal);
|
||||
a^.WriteAsmList;
|
||||
a^.AsmClose;
|
||||
a^.DoAssemble;
|
||||
a^.synchronize;
|
||||
dispose(a,Done);
|
||||
a.AsmCreate(cut_normal);
|
||||
a.WriteAsmList;
|
||||
a.AsmClose;
|
||||
a.DoAssemble;
|
||||
a.synchronize;
|
||||
a.Free;
|
||||
end;
|
||||
|
||||
|
||||
Procedure OnlyAsm;
|
||||
var
|
||||
a : PAsmList;
|
||||
a : TExternalAssembler;
|
||||
begin
|
||||
a:=new(pasmlist,Init(false));
|
||||
a^.DoAssemble;
|
||||
dispose(a,Done);
|
||||
a:=TExternalAssembler.Create(false);
|
||||
a.DoAssemble;
|
||||
a.Free;
|
||||
end;
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.14 2001-02-26 08:08:16 michael
|
||||
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
|
||||
|
||||
@ -32,10 +32,9 @@ interface
|
||||
aasm,assemble;
|
||||
|
||||
type
|
||||
pi386attasmlist=^ti386attasmlist;
|
||||
ti386attasmlist=object(tasmlist)
|
||||
procedure WriteTree(p:TAAsmoutput);virtual;
|
||||
procedure WriteAsmList;virtual;
|
||||
T386ATTAssembler=class(texternalassembler)
|
||||
procedure WriteTree(p:TAAsmoutput);override;
|
||||
procedure WriteAsmList;override;
|
||||
{$ifdef GDB}
|
||||
procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
|
||||
procedure WriteFileEndInfo;
|
||||
@ -291,7 +290,7 @@ interface
|
||||
|
||||
|
||||
{$ifdef GDB}
|
||||
procedure ti386attasmlist.WriteFileLineInfo(var fileinfo : tfileposinfo);
|
||||
procedure T386ATTAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo);
|
||||
var
|
||||
curr_n : byte;
|
||||
begin
|
||||
@ -339,7 +338,7 @@ interface
|
||||
stabslastfileinfo:=fileinfo;
|
||||
end;
|
||||
|
||||
procedure ti386attasmlist.WriteFileEndInfo;
|
||||
procedure T386ATTAssembler.WriteFileEndInfo;
|
||||
|
||||
begin
|
||||
if not ((cs_debuginfo in aktmoduleswitches) or
|
||||
@ -354,7 +353,7 @@ interface
|
||||
{$endif GDB}
|
||||
|
||||
|
||||
procedure ti386attasmlist.WriteTree(p:TAAsmoutput);
|
||||
procedure T386ATTAssembler.WriteTree(p:TAAsmoutput);
|
||||
const
|
||||
allocstr : array[boolean] of string[10]=(' released',' allocated');
|
||||
nolinetai =[ait_label,
|
||||
@ -816,7 +815,7 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
procedure ti386attasmlist.WriteAsmList;
|
||||
procedure T386ATTAssembler.WriteAsmList;
|
||||
var
|
||||
p:dirstr;
|
||||
n:namestr;
|
||||
@ -893,7 +892,10 @@ interface
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2001-01-13 20:24:24 peter
|
||||
Revision 1.4 2001-03-05 21:39:11 peter
|
||||
* changed to class with common TAssembler also for internal assembler
|
||||
|
||||
Revision 1.3 2001/01/13 20:24:24 peter
|
||||
* fixed operand order that got mixed up for external writers after
|
||||
my previous assembler block valid instruction check
|
||||
|
||||
|
||||
@ -38,11 +38,10 @@ interface
|
||||
type
|
||||
togtype=(og_none,og_dbg,og_coff,og_pecoff,og_elf);
|
||||
|
||||
pi386binasmlist=^ti386binasmlist;
|
||||
ti386binasmlist=object
|
||||
SmartAsm : boolean;
|
||||
constructor init(t:togtype;smart:boolean);
|
||||
destructor done;
|
||||
TInternalAssembler=class(TAssembler)
|
||||
public
|
||||
constructor create(t:togtype;smart:boolean);
|
||||
destructor destroy;override;
|
||||
procedure WriteBin;
|
||||
private
|
||||
{ the aasmoutput lists that need to be processed }
|
||||
@ -73,7 +72,7 @@ interface
|
||||
procedure writetreesmart;
|
||||
end;
|
||||
|
||||
implementation
|
||||
implementation
|
||||
|
||||
uses
|
||||
{$ifdef delphi}
|
||||
@ -93,7 +92,7 @@ interface
|
||||
|
||||
{$ifdef GDB}
|
||||
|
||||
procedure ti386binasmlist.convertstabs(p:pchar);
|
||||
procedure TInternalAssembler.convertstabs(p:pchar);
|
||||
var
|
||||
ofs,
|
||||
nidx,nother,ii,i,line,j : longint;
|
||||
@ -236,7 +235,7 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
procedure ti386binasmlist.emitlineinfostabs(nidx,line : longint);
|
||||
procedure TInternalAssembler.emitlineinfostabs(nidx,line : longint);
|
||||
var
|
||||
sec : tsection;
|
||||
begin
|
||||
@ -264,14 +263,14 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
procedure ti386binasmlist.emitstabs(s:string);
|
||||
procedure TInternalAssembler.emitstabs(s:string);
|
||||
begin
|
||||
s:=s+#0;
|
||||
ConvertStabs(@s[1]);
|
||||
end;
|
||||
|
||||
|
||||
procedure ti386binasmlist.WriteFileLineInfo(var fileinfo : tfileposinfo);
|
||||
procedure TInternalAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo);
|
||||
var
|
||||
curr_n : byte;
|
||||
hp : pasmsymbol;
|
||||
@ -313,7 +312,7 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
procedure ti386binasmlist.StartFileLineInfo;
|
||||
procedure TInternalAssembler.StartFileLineInfo;
|
||||
var
|
||||
fileinfo : tfileposinfo;
|
||||
begin
|
||||
@ -328,7 +327,7 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
procedure ti386binasmlist.EndFileLineInfo;
|
||||
procedure TInternalAssembler.EndFileLineInfo;
|
||||
var
|
||||
hp : pasmsymbol;
|
||||
store_sec : tsection;
|
||||
@ -352,7 +351,7 @@ interface
|
||||
{$endif GDB}
|
||||
|
||||
|
||||
function ti386binasmlist.MaybeNextList(var hp:Tai):boolean;
|
||||
function TInternalAssembler.MaybeNextList(var hp:Tai):boolean;
|
||||
begin
|
||||
{ maybe end of list }
|
||||
while not assigned(hp) do
|
||||
@ -373,7 +372,7 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
function ti386binasmlist.TreePass0(hp:Tai):Tai;
|
||||
function TInternalAssembler.TreePass0(hp:Tai):Tai;
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
@ -452,7 +451,7 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
function ti386binasmlist.TreePass1(hp:Tai):Tai;
|
||||
function TInternalAssembler.TreePass1(hp:Tai):Tai;
|
||||
var
|
||||
i,l : longint;
|
||||
begin
|
||||
@ -623,7 +622,7 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
function ti386binasmlist.TreePass2(hp:Tai):Tai;
|
||||
function TInternalAssembler.TreePass2(hp:Tai):Tai;
|
||||
var
|
||||
l : longint;
|
||||
{$ifdef I386}
|
||||
@ -744,7 +743,7 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
procedure ti386binasmlist.writetree;
|
||||
procedure TInternalAssembler.writetree;
|
||||
var
|
||||
hp : Tai;
|
||||
label
|
||||
@ -753,7 +752,8 @@ interface
|
||||
objectalloc.resetsections;
|
||||
objectalloc.setsection(sec_code);
|
||||
|
||||
objectdata:=objectoutput.initwriting(cut_normal);
|
||||
objectoutput.initwriting(ObjFile);
|
||||
objectdata:=objectoutput.data;
|
||||
objectdata.defaultsection(sec_code);
|
||||
{ reset the asmsymbol list }
|
||||
CreateUsedAsmsymbolList;
|
||||
@ -838,7 +838,7 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
procedure ti386binasmlist.writetreesmart;
|
||||
procedure TInternalAssembler.writetreesmart;
|
||||
var
|
||||
hp : Tai;
|
||||
startsec : tsection;
|
||||
@ -847,7 +847,9 @@ interface
|
||||
objectalloc.resetsections;
|
||||
objectalloc.setsection(sec_code);
|
||||
|
||||
objectdata:=objectoutput.initwriting(cut_normal);
|
||||
NextSmartName(cut_normal);
|
||||
objectoutput.initwriting(ObjFile);
|
||||
objectdata:=objectoutput.data;
|
||||
objectdata.defaultsection(sec_code);
|
||||
startsec:=sec_code;
|
||||
|
||||
@ -940,7 +942,9 @@ interface
|
||||
hp:=Tai(hp.next);
|
||||
end;
|
||||
|
||||
objectdata:=objectoutput.initwriting(place);
|
||||
NextSmartName(place);
|
||||
objectoutput.initwriting(ObjFile);
|
||||
objectdata:=objectoutput.data;
|
||||
|
||||
hp:=Tai(hp.next);
|
||||
|
||||
@ -954,7 +958,7 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
procedure ti386binasmlist.writebin;
|
||||
procedure TInternalAssembler.writebin;
|
||||
|
||||
procedure addlist(p:TAAsmoutput);
|
||||
begin
|
||||
@ -987,17 +991,18 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
constructor ti386binasmlist.init(t:togtype;smart:boolean);
|
||||
constructor TInternalAssembler.create(t:togtype;smart:boolean);
|
||||
begin
|
||||
inherited create(smart);
|
||||
case t of
|
||||
og_none :
|
||||
Message(asmw_f_no_binary_writer_selected);
|
||||
og_coff :
|
||||
objectoutput:=tcoffoutput.createdjgpp(smart);
|
||||
objectoutput:=tcoffobjectoutput.createdjgpp(smart);
|
||||
og_pecoff :
|
||||
objectoutput:=tcoffoutput.createwin32(smart);
|
||||
objectoutput:=tcoffobjectoutput.createwin32(smart);
|
||||
og_elf :
|
||||
objectoutput:=telf32output.create(smart);
|
||||
objectoutput:=telf32objectoutput.create(smart);
|
||||
else
|
||||
internalerror(43243432);
|
||||
end;
|
||||
@ -1007,7 +1012,7 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
destructor ti386binasmlist.done;
|
||||
destructor TInternalAssembler.destroy;
|
||||
{$ifdef MEMDEBUG}
|
||||
var
|
||||
d : tmemdebug;
|
||||
@ -1026,7 +1031,10 @@ interface
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2000-12-25 00:07:31 peter
|
||||
Revision 1.5 2001-03-05 21:39:11 peter
|
||||
* changed to class with common TAssembler also for internal assembler
|
||||
|
||||
Revision 1.4 2000/12/25 00:07:31 peter
|
||||
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
|
||||
tlinkedlist objects)
|
||||
|
||||
|
||||
@ -29,10 +29,9 @@ interface
|
||||
uses aasm,assemble;
|
||||
|
||||
type
|
||||
pi386intasmlist=^ti386intasmlist;
|
||||
ti386intasmlist = object(tasmlist)
|
||||
procedure WriteTree(p:TAAsmoutput);virtual;
|
||||
procedure WriteAsmList;virtual;
|
||||
T386IntelAssembler = class(TExternalAssembler)
|
||||
procedure WriteTree(p:TAAsmoutput);override;
|
||||
procedure WriteAsmList;override;
|
||||
procedure WriteExternals;
|
||||
end;
|
||||
|
||||
@ -291,7 +290,7 @@ interface
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
TI386INTASMLIST
|
||||
T386IntelAssembler
|
||||
****************************************************************************}
|
||||
|
||||
var
|
||||
@ -323,7 +322,7 @@ interface
|
||||
PadTabs:=s+#9;
|
||||
end;
|
||||
|
||||
procedure ti386intasmlist.WriteTree(p:TAAsmoutput);
|
||||
procedure T386IntelAssembler.WriteTree(p:TAAsmoutput);
|
||||
const
|
||||
allocstr : array[boolean] of string[10]=(' released',' allocated');
|
||||
var
|
||||
@ -675,28 +674,28 @@ ait_stab_function_name : ;
|
||||
end;
|
||||
|
||||
var
|
||||
currentasmlist : PAsmList;
|
||||
currentasmlist : TExternalAssembler;
|
||||
|
||||
procedure writeexternal(p:pnamedindexobject);
|
||||
begin
|
||||
if pasmsymbol(p)^.defbind=AB_EXTERNAL then
|
||||
begin
|
||||
if (aktoutputformat = as_i386_masm) then
|
||||
currentasmlist^.AsmWriteln(#9'EXTRN'#9+p^.name
|
||||
currentasmlist.AsmWriteln(#9'EXTRN'#9+p^.name
|
||||
+': NEAR')
|
||||
else
|
||||
currentasmlist^.AsmWriteln(#9'EXTRN'#9+p^.name);
|
||||
currentasmlist.AsmWriteln(#9'EXTRN'#9+p^.name);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ti386intasmlist.WriteExternals;
|
||||
procedure T386IntelAssembler.WriteExternals;
|
||||
begin
|
||||
currentasmlist:=@self;
|
||||
currentasmlist:=self;
|
||||
AsmSymbolList^.foreach({$ifdef fpcprocvar}@{$endif}writeexternal);
|
||||
end;
|
||||
|
||||
|
||||
procedure ti386intasmlist.WriteAsmList;
|
||||
procedure T386IntelAssembler.WriteAsmList;
|
||||
begin
|
||||
{$ifdef EXTDEBUG}
|
||||
if assigned(current_module.mainsource) then
|
||||
@ -740,7 +739,10 @@ ait_stab_function_name : ;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 2001-02-20 21:36:39 peter
|
||||
Revision 1.7 2001-03-05 21:39:11 peter
|
||||
* changed to class with common TAssembler also for internal assembler
|
||||
|
||||
Revision 1.6 2001/02/20 21:36:39 peter
|
||||
* tasm/masm fixes merged
|
||||
|
||||
Revision 1.5 2001/01/13 20:24:24 peter
|
||||
|
||||
@ -30,10 +30,9 @@ interface
|
||||
uses aasm,assemble;
|
||||
|
||||
type
|
||||
pi386nasmasmlist=^ti386nasmasmlist;
|
||||
ti386nasmasmlist = object(tasmlist)
|
||||
procedure WriteTree(p:taasmoutput);virtual;
|
||||
procedure WriteAsmList;virtual;
|
||||
T386NasmAssembler = class(texternalassembler)
|
||||
procedure WriteTree(p:taasmoutput);override;
|
||||
procedure WriteAsmList;override;
|
||||
procedure WriteExternals;
|
||||
end;
|
||||
|
||||
@ -305,7 +304,7 @@ interface
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Ti386nasmasmlist
|
||||
T386NasmAssembler
|
||||
****************************************************************************}
|
||||
|
||||
var
|
||||
@ -335,7 +334,7 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
procedure ti386nasmasmlist.WriteTree(p:taasmoutput);
|
||||
procedure T386NasmAssembler.WriteTree(p:taasmoutput);
|
||||
const
|
||||
allocstr : array[boolean] of string[10]=(' released',' allocated');
|
||||
nolinetai =[ait_label,
|
||||
@ -715,22 +714,22 @@ interface
|
||||
|
||||
|
||||
var
|
||||
currentasmlist : PAsmList;
|
||||
currentasmlist : TExternalAssembler;
|
||||
|
||||
procedure writeexternal(p:pnamedindexobject);
|
||||
begin
|
||||
if pasmsymbol(p)^.defbind=AB_EXTERNAL then
|
||||
currentasmlist^.AsmWriteln('EXTERN'#9+p^.name);
|
||||
currentasmlist.AsmWriteln('EXTERN'#9+p^.name);
|
||||
end;
|
||||
|
||||
procedure ti386nasmasmlist.WriteExternals;
|
||||
procedure T386NasmAssembler.WriteExternals;
|
||||
begin
|
||||
currentasmlist:=@self;
|
||||
currentasmlist:=self;
|
||||
AsmSymbolList^.foreach({$ifdef fpcprocvar}@{$endif}writeexternal);
|
||||
end;
|
||||
|
||||
|
||||
procedure ti386nasmasmlist.WriteAsmList;
|
||||
procedure T386NasmAssembler.WriteAsmList;
|
||||
begin
|
||||
{$ifdef EXTDEBUG}
|
||||
if assigned(current_module.mainsource) then
|
||||
@ -774,7 +773,10 @@ interface
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2001-02-20 21:36:39 peter
|
||||
Revision 1.6 2001-03-05 21:39:11 peter
|
||||
* changed to class with common TAssembler also for internal assembler
|
||||
|
||||
Revision 1.5 2001/02/20 21:36:39 peter
|
||||
* tasm/masm fixes merged
|
||||
|
||||
Revision 1.4 2001/01/13 20:24:24 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user