mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 04:29:20 +02:00
powerpc: clean up and simplify the PPC version of the VASM writer (based on the 68k version), and also enable it for AmigaOS4/PPC and Linux/PPC
git-svn-id: trunk@35117 -
This commit is contained in:
parent
026f0e99f3
commit
d52c75ba17
@ -1,7 +1,7 @@
|
|||||||
{
|
{
|
||||||
Copyright (c) 1998-2002 by Florian Klaempfl
|
Copyright (c) 2016 by the Free Pascal development team
|
||||||
|
|
||||||
This unit is the VASM writer for PowerPC
|
This unit is the VASM assembler writer for PowerPC
|
||||||
|
|
||||||
This program is free software; you can redistribute it and/or modify
|
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
|
it under the terms of the GNU General Public License as published by
|
||||||
@ -20,41 +20,29 @@
|
|||||||
****************************************************************************
|
****************************************************************************
|
||||||
}
|
}
|
||||||
|
|
||||||
{****************************************************************************}
|
|
||||||
{ Helper routines for Instruction Writer }
|
|
||||||
{****************************************************************************}
|
|
||||||
|
|
||||||
unit agppcvasm;
|
unit agppcvasm;
|
||||||
|
|
||||||
{$i fpcdefs.inc}
|
{$i fpcdefs.inc}
|
||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
aasmbase,systems,
|
aasmbase,systems,
|
||||||
aasmtai,aasmdata,
|
aasmtai,aasmdata,
|
||||||
assemble,aggas,
|
assemble,aggas,agppcgas,
|
||||||
cpubase,cgutils,
|
cpubase,cgutils,
|
||||||
globtype;
|
globtype;
|
||||||
|
|
||||||
type
|
type
|
||||||
TPPCInstrWriter=class(TCPUInstrWriter)
|
tppcvasm = class(TPPCGNUassembler)
|
||||||
procedure WriteInstruction(hp : tai);override;
|
protected
|
||||||
end;
|
function sectionattrs(atype:TAsmSectiontype):string; override;
|
||||||
|
public
|
||||||
TPPCVASM=class(TGNUassembler)
|
|
||||||
constructor CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean); override;
|
constructor CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean); override;
|
||||||
function MakeCmdLine: TCmdStr; override;
|
function MakeCmdLine: TCmdStr; override;
|
||||||
|
procedure WriteExtraHeader; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
topstr = string[4];
|
|
||||||
|
|
||||||
function getreferencestring(var ref : treference) : string;
|
|
||||||
function getopstr_jmp(const o:toper) : string;
|
|
||||||
function getopstr(const o:toper) : string;
|
|
||||||
function branchmode(o: tasmop): topstr;
|
|
||||||
function cond2str(op: tasmop; c: tasmcond): string;
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
@ -64,324 +52,62 @@ unit agppcvasm;
|
|||||||
itcpugas,cpuinfo,
|
itcpugas,cpuinfo,
|
||||||
aasmcpu;
|
aasmcpu;
|
||||||
|
|
||||||
{$ifdef cpu64bitaddr}
|
|
||||||
const
|
|
||||||
refaddr2str: array[trefaddr] of string[9] = ('', '', '', '', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta');
|
|
||||||
verbose_refaddrs = [addr_low, addr_high, addr_higher, addr_highest, addr_higha, addr_highera, addr_highesta];
|
|
||||||
refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','','lo16', 'hi16', '@err', '@err', 'ha16', '@err', '@err');
|
|
||||||
{$else cpu64bitaddr}
|
|
||||||
const
|
|
||||||
refaddr2str: array[trefaddr] of string[3] = ('','','','','@l','@h','@ha');
|
|
||||||
refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','','lo16','hi16','ha16');
|
|
||||||
verbose_refaddrs = [addr_low,addr_high,addr_higha];
|
|
||||||
{$endif cpu64bitaddr}
|
|
||||||
|
|
||||||
|
|
||||||
function getreferencestring(var ref : treference) : string;
|
|
||||||
var
|
|
||||||
s : string;
|
|
||||||
begin
|
|
||||||
with ref do
|
|
||||||
begin
|
|
||||||
if ((offset < -32768) or (offset > 32767)) and
|
|
||||||
(refaddr = addr_no) then
|
|
||||||
internalerror(2006052501);
|
|
||||||
if (refaddr = addr_no) then
|
|
||||||
s := ''
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
if target_info.system in [system_powerpc_darwin,system_powerpc64_darwin] then
|
|
||||||
s := refaddr2str_darwin[refaddr]
|
|
||||||
else
|
|
||||||
s :='';
|
|
||||||
s := s+'(';
|
|
||||||
if assigned(symbol) then
|
|
||||||
begin
|
|
||||||
s:=s+symbol.name;
|
|
||||||
if assigned(relsymbol) then
|
|
||||||
s:=s+'-'+relsymbol.name;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
if offset<0 then
|
|
||||||
s:=s+tostr(offset)
|
|
||||||
else
|
|
||||||
if (offset>0) then
|
|
||||||
begin
|
|
||||||
if assigned(symbol) then
|
|
||||||
s:=s+'+'+tostr(offset)
|
|
||||||
else
|
|
||||||
s:=s+tostr(offset);
|
|
||||||
end;
|
|
||||||
|
|
||||||
if (refaddr in verbose_refaddrs) then
|
|
||||||
begin
|
|
||||||
s := s+')';
|
|
||||||
if not(target_info.system in [system_powerpc_darwin,system_powerpc64_darwin]) then
|
|
||||||
s := s+refaddr2str[refaddr];
|
|
||||||
end;
|
|
||||||
{$ifdef cpu64bitaddr}
|
|
||||||
if (refaddr = addr_pic) then
|
|
||||||
if (target_info.system <> system_powerpc64_linux) then
|
|
||||||
s := s + ')'
|
|
||||||
else
|
|
||||||
s := s + ')@got';
|
|
||||||
{$endif cpu64bitaddr}
|
|
||||||
|
|
||||||
if (index=NR_NO) then
|
|
||||||
begin
|
|
||||||
if offset=0 then
|
|
||||||
begin
|
|
||||||
if not (assigned(symbol)) then
|
|
||||||
s:=s+'0';
|
|
||||||
end;
|
|
||||||
if (base<>NR_NO) then
|
|
||||||
s:=s+'('+gas_regname(base)+')'
|
|
||||||
else if not assigned(symbol) and
|
|
||||||
not(refaddr in verbose_refaddrs) then
|
|
||||||
s:=s+'(0)';
|
|
||||||
end
|
|
||||||
else if (index<>NR_NO) and (base<>NR_NO) then
|
|
||||||
begin
|
|
||||||
if (offset=0) then
|
|
||||||
s:=s+gas_regname(base)+','+gas_regname(index)
|
|
||||||
else
|
|
||||||
internalerror(2006052502);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
getreferencestring:=s;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function getopstr_jmp(const o:toper) : string;
|
|
||||||
var
|
|
||||||
hs : string;
|
|
||||||
begin
|
|
||||||
case o.typ of
|
|
||||||
top_reg :
|
|
||||||
getopstr_jmp:=gas_regname(o.reg);
|
|
||||||
{ no top_ref jumping for powerpc }
|
|
||||||
top_const :
|
|
||||||
getopstr_jmp:=tostr(o.val);
|
|
||||||
top_ref :
|
|
||||||
begin
|
|
||||||
if o.ref^.refaddr<>addr_full then
|
|
||||||
internalerror(200402264);
|
|
||||||
hs:=o.ref^.symbol.name;
|
|
||||||
if o.ref^.offset>0 then
|
|
||||||
hs:=hs+'+'+tostr(o.ref^.offset)
|
|
||||||
else
|
|
||||||
if o.ref^.offset<0 then
|
|
||||||
hs:=hs+tostr(o.ref^.offset);
|
|
||||||
getopstr_jmp:=hs;
|
|
||||||
end;
|
|
||||||
top_none:
|
|
||||||
getopstr_jmp:='';
|
|
||||||
else
|
|
||||||
internalerror(2002070603);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function getopstr(const o:toper) : string;
|
|
||||||
var
|
|
||||||
hs : string;
|
|
||||||
begin
|
|
||||||
case o.typ of
|
|
||||||
top_reg:
|
|
||||||
getopstr:=gas_regname(o.reg);
|
|
||||||
top_const:
|
|
||||||
getopstr:=tostr(longint(o.val));
|
|
||||||
top_ref:
|
|
||||||
if o.ref^.refaddr=addr_full then
|
|
||||||
begin
|
|
||||||
hs:=o.ref^.symbol.name;
|
|
||||||
if o.ref^.offset>0 then
|
|
||||||
hs:=hs+'+'+tostr(o.ref^.offset)
|
|
||||||
else
|
|
||||||
if o.ref^.offset<0 then
|
|
||||||
hs:=hs+tostr(o.ref^.offset);
|
|
||||||
getopstr:=hs;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
getopstr:=getreferencestring(o.ref^);
|
|
||||||
else
|
|
||||||
internalerror(2002070604);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function branchmode(o: tasmop): topstr;
|
|
||||||
var tempstr: topstr;
|
|
||||||
begin
|
|
||||||
tempstr := '';
|
|
||||||
case o of
|
|
||||||
A_BCCTR,A_BCCTRL: tempstr := 'ctr';
|
|
||||||
A_BCLR,A_BCLRL: tempstr := 'lr';
|
|
||||||
end;
|
|
||||||
case o of
|
|
||||||
A_BL,A_BLA,A_BCL,A_BCLA,A_BCCTRL,A_BCLRL: tempstr := tempstr+'l';
|
|
||||||
end;
|
|
||||||
case o of
|
|
||||||
A_BA,A_BLA,A_BCA,A_BCLA: tempstr:=tempstr+'a';
|
|
||||||
end;
|
|
||||||
branchmode := tempstr;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function cond2str(op: tasmop; c: tasmcond): string;
|
|
||||||
{ note: no checking is performed whether the given combination of }
|
|
||||||
{ conditions is valid }
|
|
||||||
var
|
|
||||||
tempstr: string;
|
|
||||||
begin
|
|
||||||
tempstr:=#9;
|
|
||||||
case c.simple of
|
|
||||||
false:
|
|
||||||
begin
|
|
||||||
cond2str := tempstr+gas_op2str[op];
|
|
||||||
case c.dirhint of
|
|
||||||
DH_None:;
|
|
||||||
DH_Minus:
|
|
||||||
cond2str:=cond2str+'-';
|
|
||||||
DH_Plus:
|
|
||||||
cond2str:=cond2str+'+';
|
|
||||||
else
|
|
||||||
internalerror(2003112901);
|
|
||||||
end;
|
|
||||||
cond2str:=cond2str+#9+tostr(c.bo)+','+tostr(c.bi);
|
|
||||||
end;
|
|
||||||
true:
|
|
||||||
if (op >= A_B) and (op <= A_BCLRL) then
|
|
||||||
case c.cond of
|
|
||||||
{ unconditional branch }
|
|
||||||
C_NONE:
|
|
||||||
cond2str := tempstr+gas_op2str[op];
|
|
||||||
{ bdnzt etc }
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
tempstr := tempstr+'b'+asmcondflag2str[c.cond]+
|
|
||||||
branchmode(op);
|
|
||||||
case c.dirhint of
|
|
||||||
DH_None:
|
|
||||||
tempstr:=tempstr+#9;
|
|
||||||
DH_Minus:
|
|
||||||
tempstr:=tempstr+('-'+#9);
|
|
||||||
DH_Plus:
|
|
||||||
tempstr:=tempstr+('+'+#9);
|
|
||||||
else
|
|
||||||
internalerror(2003112901);
|
|
||||||
end;
|
|
||||||
case c.cond of
|
|
||||||
C_LT..C_NU:
|
|
||||||
cond2str := tempstr+gas_regname(newreg(R_SPECIALREGISTER,c.cr,R_SUBWHOLE));
|
|
||||||
C_T,C_F,C_DNZT,C_DNZF,C_DZT,C_DZF:
|
|
||||||
cond2str := tempstr+tostr(c.crbit);
|
|
||||||
else
|
|
||||||
cond2str := tempstr;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
{ we have a trap instruction }
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
internalerror(2002070601);
|
|
||||||
{ not yet implemented !!!!!!!!!!!!!!!!!!!!! }
|
|
||||||
{ case tempstr := 'tw';}
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
{****************************************************************************}
|
{****************************************************************************}
|
||||||
{ PowerPC Instruction Writer }
|
{ VASM PPC Assembler writer }
|
||||||
{****************************************************************************}
|
|
||||||
|
|
||||||
Procedure TPPCInstrWriter.WriteInstruction(hp : tai);
|
|
||||||
var op: TAsmOp;
|
|
||||||
s: string;
|
|
||||||
i: byte;
|
|
||||||
sep: string[3];
|
|
||||||
begin
|
|
||||||
op:=taicpu(hp).opcode;
|
|
||||||
if is_calljmp(op) then
|
|
||||||
begin
|
|
||||||
{ direct BO/BI in op[0] and op[1] not supported, put them in condition! }
|
|
||||||
case op of
|
|
||||||
A_B,A_BA,A_BL,A_BLA:
|
|
||||||
s:=#9+gas_op2str[op]+#9;
|
|
||||||
A_BCTR,A_BCTRL,A_BLR,A_BLRL:
|
|
||||||
s:=#9+gas_op2str[op]
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
s:=cond2str(op,taicpu(hp).condition);
|
|
||||||
if (s[length(s)] <> #9) and
|
|
||||||
(taicpu(hp).ops>0) then
|
|
||||||
s := s + ',';
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
if (taicpu(hp).ops>0) and (taicpu(hp).oper[0]^.typ<>top_none) then
|
|
||||||
begin
|
|
||||||
{ first write the current contents of s, because the symbol }
|
|
||||||
{ may be 255 characters }
|
|
||||||
owner.writer.AsmWrite(s);
|
|
||||||
s:=getopstr_jmp(taicpu(hp).oper[0]^);
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
{ process operands }
|
|
||||||
begin
|
|
||||||
s:=#9+gas_op2str[op];
|
|
||||||
if taicpu(hp).ops<>0 then
|
|
||||||
begin
|
|
||||||
{
|
|
||||||
if not is_calljmp(op) then
|
|
||||||
sep:=','
|
|
||||||
else
|
|
||||||
}
|
|
||||||
sep:=#9;
|
|
||||||
for i:=0 to taicpu(hp).ops-1 do
|
|
||||||
begin
|
|
||||||
// debug code
|
|
||||||
// writeln(s);
|
|
||||||
// writeln(taicpu(hp).fileinfo.line);
|
|
||||||
s:=s+sep+getopstr(taicpu(hp).oper[i]^);
|
|
||||||
sep:=',';
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
owner.writer.AsmWriteLn(s);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
{****************************************************************************}
|
|
||||||
{ GNU PPC Assembler writer }
|
|
||||||
{****************************************************************************}
|
{****************************************************************************}
|
||||||
|
|
||||||
|
|
||||||
constructor TPPCVASM.CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean);
|
constructor tppcvasm.CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean);
|
||||||
begin
|
begin
|
||||||
inherited;
|
inherited;
|
||||||
InstrWriter := TPPCInstrWriter.create(self);
|
InstrWriter := TPPCInstrWriter.create(self);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TPPCVASM.MakeCmdLine: TCmdStr;
|
function tppcvasm.sectionattrs(atype:TAsmSectiontype):string;
|
||||||
|
begin
|
||||||
|
case atype of
|
||||||
|
sec_code, sec_fpc, sec_init, sec_fini:
|
||||||
|
result:='acrx';
|
||||||
|
sec_data:
|
||||||
|
result:='adrw';
|
||||||
|
sec_rodata, sec_rodata_norel:
|
||||||
|
result:='adr';
|
||||||
|
sec_bss, sec_threadvar:
|
||||||
|
result:='aurw';
|
||||||
|
sec_stab, sec_stabstr:
|
||||||
|
result:='dr';
|
||||||
|
else
|
||||||
|
result:='';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function tppcvasm.MakeCmdLine: TCmdStr;
|
||||||
|
var
|
||||||
|
objtype: string;
|
||||||
begin
|
begin
|
||||||
result:=asminfo^.asmcmd;
|
result:=asminfo^.asmcmd;
|
||||||
|
|
||||||
if (cs_link_on_target in current_settings.globalswitches) then
|
objtype:='-Felf';
|
||||||
begin
|
if (target_info.system in [system_powerpc_amiga, system_powerpc_morphos]) then
|
||||||
Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName)));
|
begin
|
||||||
Replace(result,'$OBJ',maybequoted(ScriptFixFileName(ObjFileName)));
|
Replace(result,'$ASM',maybequoted(ScriptFixFileName(Unix2AmigaPath(AsmFileName))));
|
||||||
end
|
Replace(result,'$OBJ',maybequoted(ScriptFixFileName(Unix2AmigaPath(ObjFileName))));
|
||||||
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
Replace(result,'$ASM',maybequoted(Unix2AmigaPath(AsmFileName)));
|
Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName)));
|
||||||
Replace(result,'$OBJ',maybequoted(Unix2AmigaPath(ObjFileName)));
|
Replace(result,'$OBJ',maybequoted(ScriptFixFileName(ObjFileName)));
|
||||||
end;
|
end;
|
||||||
|
Replace(result,'$OTYPE',objtype);
|
||||||
Replace(result,'$EXTRAOPT',asmextraopt);
|
Replace(result,'$EXTRAOPT',asmextraopt);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure tppcvasm.WriteExtraHeader;
|
||||||
|
begin
|
||||||
|
{ no-op, compared to the PPC GAS writer, because vasm defines
|
||||||
|
the register symbols by default, so lets not redefine them }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
@ -394,15 +120,15 @@ unit agppcvasm;
|
|||||||
id : as_powerpc_vasm;
|
id : as_powerpc_vasm;
|
||||||
|
|
||||||
idtxt : 'VASM';
|
idtxt : 'VASM';
|
||||||
asmbin : 'fpcvasm';
|
asmbin : 'vasmppc_std';
|
||||||
asmcmd: '-quiet -Felf -o $OBJ $EXTRAOPT $ASM';
|
asmcmd: '-quiet $OTYPE -o $OBJ $EXTRAOPT $ASM';
|
||||||
supported_targets : [system_powerpc_morphos];
|
supported_targets : [system_powerpc_amiga,system_powerpc_morphos,system_powerpc_linux];
|
||||||
flags : [af_needar,af_smartlink_sections];
|
flags : [af_needar{,af_smartlink_sections}];
|
||||||
labelprefix : '.L';
|
labelprefix : '.L';
|
||||||
comment : '# ';
|
comment : '# ';
|
||||||
dollarsign: '$';
|
dollarsign: '$';
|
||||||
);
|
);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
RegisterAssembler(as_powerpc_vasm_info,TPPCVASM);
|
RegisterAssembler(as_powerpc_vasm_info,tppcvasm);
|
||||||
end.
|
end.
|
||||||
|
Loading…
Reference in New Issue
Block a user