paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-23 02:51:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* changed to class with common TAssembler also for internal assembler

Browse Source
This commit is contained in:
peter 2001-03-05 21:39:11 +00:00
parent 3eb9c758fb
commit 1b1f938c43
5 changed files with 427 additions and 402 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

691
compiler/assemble.pas
View File

@ -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

20
compiler/i386/ag386att.pas
View File

@ -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

64
compiler/i386/ag386bin.pas
View File

@ -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)

28
compiler/i386/ag386int.pas
View File

@ -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

26
compiler/i386/ag386nsm.pas
View File

@ -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