mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 08:06:06 +02:00
6264028af1
* fixed operand postfix for floating point instructions * fixed wrong shifter constant handling
357 lines
9.8 KiB
ObjectPascal
357 lines
9.8 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 2003 by Florian Klaempfl
|
|
|
|
This unit implements an asm for the ARM
|
|
|
|
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.
|
|
|
|
****************************************************************************
|
|
}
|
|
{ This unit implements the GNU Assembler writer for the ARM
|
|
}
|
|
|
|
unit agarmgas;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
aasmtai,
|
|
aggas,
|
|
cpubase;
|
|
|
|
type
|
|
PARMGNUAssembler=^TARMGNUAssembler;
|
|
TARMGNUAssembler=class(TGNUassembler)
|
|
procedure WriteInstruction(hp : tai);override;
|
|
end;
|
|
|
|
var
|
|
gas_reg2str : reg2strtable;
|
|
|
|
const
|
|
gas_shiftmode2str : array[tshiftmode] of string[3] = (
|
|
'','lsl','lsr','asr','ror','rrx');
|
|
|
|
function gas_regnum_search(const s:string):Tnewregister;
|
|
function gas_regname(const r:Tnewregister):string;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
cutils,globals,verbose,
|
|
systems,
|
|
assemble,
|
|
aasmcpu;
|
|
|
|
const
|
|
as_arm_gas_info : tasminfo =
|
|
(
|
|
id : as_gas;
|
|
|
|
idtxt : 'AS';
|
|
asmbin : 'as';
|
|
asmcmd : '-o $OBJ $ASM';
|
|
supported_target : system_any;
|
|
outputbinary: false;
|
|
allowdirect : true;
|
|
needar : true;
|
|
labelprefix_only_inside_procedure : false;
|
|
labelprefix : '.L';
|
|
comment : '# ';
|
|
secnames : ('',
|
|
'.text','.data','.text',
|
|
'','','','','','',
|
|
'.stab','.stabstr','COMMON')
|
|
);
|
|
|
|
function getreferencestring(var ref : treference) : string;
|
|
var
|
|
s : string;
|
|
nobase,noindex : boolean;
|
|
begin
|
|
with ref do
|
|
begin
|
|
inc(offset,offsetfixup);
|
|
|
|
noindex:=(index.enum=R_NO) or ((index.enum=R_INTREGISTER) and (index.number=NR_NO));
|
|
{$ifdef extdebug}
|
|
nobase:=(base.enum=R_NO) or ((base.enum=R_INTREGISTER) and (base.number=NR_NO));
|
|
//!!!! if nobase then
|
|
//!!!! internalerror(200308292);
|
|
|
|
// !!! if (not(noindex) or (shiftmode<>SM_None)) and ((offset<>0) or (symbol<>nil)) then
|
|
// !!! internalerror(200308293);
|
|
{$endif extdebug}
|
|
|
|
if assigned(symbol) then
|
|
begin
|
|
// if (base.enum<>R_NO) and not(is_pc(base)) then
|
|
// internalerror(200309011);
|
|
s:=symbol.name;
|
|
if offset<0 then
|
|
s:=s+tostr(offset)
|
|
else if offset>0 then
|
|
s:=s+'+'+tostr(offset);
|
|
end
|
|
else
|
|
begin
|
|
if base.enum=R_INTREGISTER then
|
|
s:='['+gas_regname(base.number)
|
|
else
|
|
s:='['+gas_reg2str[base.enum];
|
|
if addressmode=AM_POSTINDEXED then
|
|
s:=s+']';
|
|
if not(noindex) then
|
|
begin
|
|
if signindex<0 then
|
|
s:=s+', -'
|
|
else
|
|
s:=s+', ';
|
|
|
|
if index.enum=R_INTREGISTER then
|
|
s:=s+gas_regname(index.number)
|
|
else
|
|
s:=s+gas_reg2str[index.enum];
|
|
|
|
if shiftmode<>SM_None then
|
|
s:=s+' ,'+gas_shiftmode2str[shiftmode]+' #'+tostr(shiftimm);
|
|
end;
|
|
case addressmode of
|
|
AM_OFFSET:
|
|
s:=s+']';
|
|
AM_PREINDEXED:
|
|
s:=s+']!';
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
getreferencestring:=s;
|
|
end;
|
|
|
|
|
|
function getopstr_jmp(const o:toper) : string;
|
|
var
|
|
hs : string;
|
|
begin
|
|
case o.typ of
|
|
top_reg :
|
|
begin
|
|
if (o.reg.enum < R_R0) or (o.reg.enum > lastreg) then
|
|
internalerror(200303121);
|
|
getopstr_jmp:=std_reg2str[o.reg.enum];
|
|
end;
|
|
top_shifterop:
|
|
begin
|
|
end;
|
|
{ no top_ref jumping for powerpc }
|
|
top_const :
|
|
getopstr_jmp:='#'+tostr(o.val);
|
|
top_symbol :
|
|
begin
|
|
hs:=o.sym.name;
|
|
if o.symofs>0 then
|
|
hs:=hs+'+'+tostr(o.symofs)
|
|
else
|
|
if o.symofs<0 then
|
|
hs:=hs+tostr(o.symofs);
|
|
getopstr_jmp:=hs;
|
|
end;
|
|
top_none:
|
|
getopstr_jmp:='';
|
|
else
|
|
{$ifndef testing}
|
|
internalerror(2002070603);
|
|
{$else testing}
|
|
begin
|
|
writeln('internalerror 10001');
|
|
halt(1);
|
|
end;
|
|
{$endif testing}
|
|
end;
|
|
end;
|
|
|
|
const
|
|
shifterop2str: array[tshiftertype] of string[3] = ('','asr','lsl','lsr','ror','rrx');
|
|
|
|
function getopstr(const o:toper) : string;
|
|
var
|
|
hs : string;
|
|
first : boolean;
|
|
r : tnewregister;
|
|
begin
|
|
case o.typ of
|
|
top_reg:
|
|
begin
|
|
if o.reg.enum=R_INTREGISTER then
|
|
getopstr:=gas_regname(o.reg.number)
|
|
else
|
|
getopstr:=gas_reg2str[o.reg.enum];
|
|
end;
|
|
top_shifterop:
|
|
begin
|
|
if (o.shifterop^.rs.enum<>R_NO) and (o.shifterop^.shiftimm=0) then
|
|
begin
|
|
if o.shifterop^.rs.enum=R_INTREGISTER then
|
|
getopstr:=shifterop2str[o.shifterop^.shiftertype]+' '+gas_regname(o.shifterop^.rs.number)
|
|
else
|
|
getopstr:=shifterop2str[o.shifterop^.shiftertype]+' '+gas_reg2str[o.shifterop^.rs.enum];
|
|
end
|
|
else if (o.shifterop^.rs.enum=R_NO) then
|
|
getopstr:=shifterop2str[o.shifterop^.shiftertype]+' #'+tostr(o.shifterop^.shiftimm)
|
|
else internalerror(200308282);
|
|
end;
|
|
top_const:
|
|
getopstr:='#'+tostr(longint(o.val));
|
|
top_regset:
|
|
begin
|
|
getopstr:='{';
|
|
first:=true;
|
|
for r:=RS_R0 to RS_R15 do
|
|
if r in o.regset then
|
|
begin
|
|
if not(first) then
|
|
getopstr:=getopstr+',';
|
|
getopstr:=getopstr+'r'+tostr(r-RS_R0);
|
|
first:=false;
|
|
end;
|
|
getopstr:=getopstr+'}';
|
|
end;
|
|
top_ref:
|
|
getopstr:=getreferencestring(o.ref^);
|
|
top_symbol:
|
|
begin
|
|
hs:=o.sym.name;
|
|
if o.symofs>0 then
|
|
hs:=hs+'+'+tostr(o.symofs)
|
|
else
|
|
if o.symofs<0 then
|
|
hs:=hs+tostr(o.symofs);
|
|
getopstr:=hs;
|
|
end;
|
|
else
|
|
{$ifndef testing}
|
|
internalerror(2002070604);
|
|
{$else testing}
|
|
begin
|
|
writeln('internalerror 10001');
|
|
halt(1);
|
|
end;
|
|
{$endif testing}
|
|
end;
|
|
end;
|
|
|
|
Procedure TARMGNUAssembler.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+op2str[op]+#9;
|
|
A_BCTR,A_BCTRL,A_BLR,A_BLRL:
|
|
s:=#9+op2str[op]
|
|
else
|
|
s:=cond2str(op,taicpu(hp).condition)+',';
|
|
end;
|
|
|
|
if (taicpu(hp).oper[0].typ <> top_none) then
|
|
s:=s+getopstr_jmp(taicpu(hp).oper[0]);
|
|
end
|
|
else
|
|
}
|
|
{ process operands }
|
|
begin
|
|
s:=#9+std_op2str[op]+cond2str[taicpu(hp).condition]+oppostfix2str[taicpu(hp).oppostfix];
|
|
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;
|
|
AsmWriteLn(s);
|
|
end;
|
|
|
|
function gas_regnum_search(const s:string):Tnewregister;
|
|
begin
|
|
end;
|
|
|
|
|
|
function gas_regname(const r:Tnewregister):string;
|
|
var s:Tsuperregister;
|
|
begin
|
|
s:=r shr 8;
|
|
if s in [RS_R0..RS_R15] then
|
|
gas_regname:='r'+tostr(s-RS_R0)
|
|
else
|
|
begin
|
|
{Generate a systematic name.}
|
|
gas_regname:='reg'+tostr(s)+'d';
|
|
end;
|
|
end;
|
|
|
|
|
|
begin
|
|
RegisterAssembler(as_arm_gas_info,TARMGNUAssembler);
|
|
gas_reg2str:=std_reg2str;
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.7 2003-09-01 15:11:16 florian
|
|
* fixed reference handling
|
|
* fixed operand postfix for floating point instructions
|
|
* fixed wrong shifter constant handling
|
|
|
|
Revision 1.6 2003/08/29 21:36:28 florian
|
|
* fixed procedure entry/exit code
|
|
* started to fix reference handling
|
|
|
|
Revision 1.5 2003/08/28 13:26:10 florian
|
|
* another couple of arm fixes
|
|
|
|
Revision 1.4 2003/08/28 00:05:29 florian
|
|
* today's arm patches
|
|
|
|
Revision 1.3 2003/08/24 12:27:26 florian
|
|
* continued to work on the arm port
|
|
|
|
Revision 1.2 2003/08/20 15:50:12 florian
|
|
* more arm stuff
|
|
|
|
Revision 1.1 2003/08/16 13:23:01 florian
|
|
* several arm related stuff fixed
|
|
}
|