paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 11:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* first implementation of concatcopy (requires 4 scratch regs)

Browse Source
This commit is contained in:
Jonas Maebe 1999-08-26 14:53:41 +00:00
parent 6531f55008
commit acc55a83c7
1 changed files with 445 additions and 381 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

826
compiler/new/powerpc/cgcpu.pas
View File

@ -1,382 +1,446 @@
{
$Id$
Copyright (c) 1993-98 by Florian Klaempfl
This unit implements the code generator for the PowerPC
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.
****************************************************************************
}
unit cgcpu;
interface
uses
cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo;
type
pcgppc = ^tcgppc;
tcgppc = object(tcg)
procedure a_call_name(list : paasmoutput;const s : string;
offset : longint);virtual;
procedure a_op_reg_const(list : paasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; a: AWord); virtual;
{ move instructions }
procedure a_load_const_reg(list : paasmoutput; size: tcgsize; a : aword;reg : tregister);virtual;
procedure a_load_reg_ref(list : paasmoutput; size: tcgsize; reg : tregister;const ref2 : treference);virtual;
procedure a_load_ref_reg(list : paasmoutput;size : tcgsize;const Ref2 : treference;reg : tregister);virtual;
procedure a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual;
{ comparison operations }
procedure a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : pasmlabel);virtual;
procedure a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel);
{ procedure a_cmp_reg_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;
const ref: treference; l : pasmlabel);
procedure a_cmp_ref_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;l : longint;reg : tregister;
l : pasmlabel);}
procedure a_loadaddress_ref_reg(list : paasmoutput;const ref2 : treference;r : tregister);virtual;
procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual;
procedure g_restore_frame_pointer(list : paasmoutput);virtual;
private
procedure a_op_reg_reg_const32(list: PAasmOutPut; OpLo, OpHi: TAsmOp;
reg1, reg2: TRegister; a: AWord);
procedure fixref(var ref: treference);
end;
const
TOpCG2AsmOpLo: Array[TOpCG] of TAsmOp = (A_ADDI,A_ANDI_,A_DIVWU,
A_DIVW,A_MULLW, A_MULLW, A_NONE,A_NONE,A_ORI,
A_SRAWI,A_SLWI,A_SRWI,A_SUBI,A_XORI);
TOpCG2AsmOpHi: Array[TOpCG] of TAsmOp = (A_ADDIS,A_ANDIS_,
A_DIVWU,A_DIVW, A_MULLW,A_MULLW,A_NONE,A_NONE,
A_ORIS,A_NONE, A_NONE,A_NONE,A_SUBIS,A_XORIS);
TOpCmp2AsmCond: Array[topcmp] of TAsmCond = (C_EQ,C_GT,C_LT,C_GE,
C_LE,C_NE,C_LE,C_NG,C_GE,C_NL);
implementation
uses
globtype,globals,verbose;
procedure tcgppc.a_call_name(list : paasmoutput;const s : string;
offset : longint);
begin
{ save our RTOC register value. Only necessary when doing pointer based }
{ calls or cross TOC calls, but currently done always }
list^.concat(new(paicpu,op_reg_ref(A_STW,R_RTOC,
new_reference(stack_pointer,LA_RTOC))));
list^.concat(new(paicpu,op_sym(A_BL,newasmsymbol(s))));
list^.concat(new(paicpu,op_reg_ref(A_LWZ,R_RTOC,
new_reference(stack_pointer,LA_RTOC))));
end;
{********************** load instructions ********************}
procedure tcgppc.a_load_const_reg(list : paasmoutput; size: TCGSize; a : aword; reg : TRegister);
begin
If (a and $ffff) <> 0 Then
Begin
list^.concat(new(paicpu,op_reg_const(A_LI,reg,a and $ffff)));
If (a shr 16) <> 0 Then
list^.concat(new(paicpu,op_reg_const(A_ORIS,reg,a shr 16)))
End
Else
list^.concat(new(paicpu,op_reg_const(A_LIS,reg,a shr 16)));
end;
procedure tcgppc.a_load_reg_ref(list : paasmoutput; size: TCGSize; reg : tregister;const ref2 : treference);
Var
op: TAsmOp;
ref: TReference;
begin
ref := ref2;
FixRef(ref);
Case size of
OS_8 : op := A_STB;
OS_16: op := A_STH;
OS_32: op := A_STW;
Else InternalError(68993)
End;
list^.concat(new(paicpu,op_reg_ref(op,reg,newreference(ref))));
End;
procedure tcgppc.a_load_ref_reg(list : paasmoutput;size : tcgsize;const ref2: treference;reg : tregister);
Var
op: TAsmOp;
ref: TReference;
begin
ref := ref2;
FixRef(ref);
Case size of
OS_8 : op := A_LBZ;
OS_16: op := A_LHZ;
OS_32: op := A_LWZ
Else InternalError(68994)
End;
list^.concat(new(paicpu,op_reg_ref(op,reg,newreference(ref))));
end;
procedure tcgppc.a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);
begin
list^.concat(new(paicpu,op_reg_reg(A_MR,reg2,reg1)));
end;
procedure tcgppc.a_op_reg_const(list : paasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; a: AWord);
var scratch_register: TRegister;
begin
Case Op of
OP_DIV, OP_IDIV, OP_IMUL, OP_MUL:
If (Op = OP_IMUL) And (longint(a) >= -32768) And
(longint(a) <= 32767) Then
list^.concat(new(paicpu,op_reg_reg_const(A_MULLI,reg,reg,a)))
Else
Begin
scratch_register := get_scratch_reg(list);
a_load_const_reg(list, OS_32, a, scratch_register);
list^.concat(new(paicpu,op_reg_reg_reg(TOpCG2AsmOpLo[Op],
reg,reg,scratch_register)));
free_scratch_reg(list,scratch_register);
End;
OP_ADD, OP_AND, OP_OR, OP_SUB,OP_XOR:
a_op_reg_reg_const32(list,TOpCG2AsmOpLo[Op],
TOpCG2AsmOpHi[Op],reg,reg,a);
OP_SHL,OP_SHR,OP_SAR:
Begin
if (a and $ffff) <> 0 Then
list^.concat(new(paicpu,op_reg_reg_const(
TOpCG2AsmOpLo[Op],reg,reg,a and $ffff)));
If (a shr 16) <> 0 Then
InternalError(68991);
End
Else InternalError(68992);
end;
end;
{*************** compare instructructions ****************}
procedure tcgppc.a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : pasmlabel);
var AsmCond: TAsmCond;
scratch_register: TRegister;
signed: boolean;
begin
signed := cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE];
If signed Then
If (longint(a) >= -32768) and (longint(a) <= 32767) Then
list^.concat(new(paicpu,op_const_reg_const(A_CMPI,0,reg,a)))
else
begin
scratch_register := get_scratch_reg(list);
a_load_const_reg(list,OS_32,a,scratch_register);
list^.concat(new(paicpu,op_const_reg_reg(A_CMP,0,reg,scratch_register)));
free_scratch_reg(list,scratch_register);
end
else
if (a <= $ffff) then
list^.concat(new(paicpu,op_const_reg_const(A_CMPLI,0,reg,a)))
else
begin
scratch_register := get_scratch_reg(list);
a_load_const_reg(list,OS_32,a,scratch_register);
list^.concat(new(paicpu,op_const_reg_reg(A_CMPL,0,reg,scratch_register)));
free_scratch_reg(list,scratch_register);
end;
AsmCond := TOpCmp2AsmCond[cmp_op];
list^.concat(new(paicpu,op_const_const_sym(A_BC,AsmCond2BO[AsmCond],
AsmCond2BI[AsmCond],newasmsymbol(l^.name))));
end;
procedure tcgppc.a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;
reg1,reg2 : tregister;l : pasmlabel);
var AsmCond: TAsmCond;
begin
list^.concat(new(paicpu,op_const_reg_reg(A_CMPL,0,reg1,reg2)));
AsmCond := TOpCmp2AsmCond[cmp_op];
list^.concat(new(paicpu,op_const_const_sym(A_BC,AsmCond2BO[AsmCond],
AsmCond2BI[AsmCond],newasmsymbol(l^.name))));
end;
{
procedure tcgpp.a_cmp_reg_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;
const ref: treference; l : pasmlabel);
var scratch_register: TRegister;
begin
scratch_register := get_scratch_reg(list);
a_load_ref_reg(list,ref,scratch_register);
a_cmp_reg_reg_label(list,size,cmp_op,reg,scratch_register,l)
free_scratch_reg(list,scratch_register);
end;
procedure tcgpp.a_cmp_ref_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;l : longint;reg : tregister;
l : pasmlabel);
var sr: TRegister;
begin
sr := get_scratch_register(list);
a_cmp
}
procedure tcgppc.a_loadaddress_ref_reg(list : paasmoutput;const ref2 : treference;r : tregister);
Var
ref: TReference;
begin
ref := ref2;
FixRef(ref);
If ref.offset <> 0 Then
If ref.base <> R_NO then
a_op_reg_reg_const32(list,A_ADDI,A_ADDIS,r,r,ref.offset)
{ FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never}
{ occurs, so now only ref.offset has to be loaded }
else a_load_const_reg(list, OS_32, ref.offset, r)
else
if ref.index <> R_NO Then
list^.concat(new(paicpu,op_reg_reg_reg(A_ADD,r,ref.base,ref.index)))
else list^.concat(new(paicpu,op_reg_reg(A_MR,r,ref.base)))
end;
{ *********** entry/exit code and address loading ************ }
procedure tcgppc.g_stackframe_entry(list : paasmoutput;localsize : longint);
{ generated the entry code of a procedure/function. Note: localsize is the }
{ sum of the size necessary for local variables and the maximum possible }
{ combined size of ALL the parameters of a procedure called by the current }
{ one }
var scratch_register: TRegister;
begin
if (localsize mod 8) <> 0 then internalerror(58991);
{ CR and LR only have to be saved in case they are modified by the current }
{ procedure, but currently this isn't checked, so save them always }
scratch_register := get_scratch_reg(list);
list^.concat(new(paicpu,op_reg(A_MFCR,scratch_register)));
list^.concat(new(paicpu,op_reg_ref(A_STW,scratch_register,
new_reference(stack_pointer,LA_CR))));
free_scratch_reg(list,scratch_register);
scratch_register := get_scratch_reg(list);
list^.concat(new(paicpu,op_reg_reg(A_MFSPR,scratch_register,
R_LR)));
list^.concat(new(paicpu,op_reg_ref(A_STW,scratch_register,
new_reference(stack_pointer,LA_LR))));
free_scratch_reg(list,scratch_register);
{ if the current procedure is a leaf procedure, we can use the Red Zone, }
{ but this is not yet implemented }
{ if (procinfo.flags and pi_do_call) <> 0 Then}
Begin
if localsize<>0 then
begin
{ allocate space for the local variable, parameter and linkage area and }
{ save the stack pointer at the end of the linkage area }
if localsize <= $ffff Then
list^.concat(new(paicpu,op_reg_ref
(A_STWU,stack_pointer, new_reference(stack_pointer,localsize+
LinkageAreaSize))))
else
Begin
scratch_register := get_scratch_reg(list);
a_load_const_reg(list,OS_32,localsize,scratch_register);
list^.concat(new(paicpu,op_reg_reg_reg(A_STWUX,stack_pointer,
stack_pointer,scratch_register)));
free_scratch_reg(list,scratch_register);
End;
End
End;
end;
procedure tcgppc.g_restore_frame_pointer(list : paasmoutput);
begin
{ no frame pointer on the PowerPC }
end;
{***************** This is private property, keep out! :) *****************}
procedure tcgppc.fixref(var ref: treference);
{ Make sure ref is a valid reference for the PowerPC and sets the base to }
{ the value of the index if (base = R_NO). (Index <> R_NO) is not checked }
{ because the less conditional jumps, the better }
begin
If (ref.base <> R_NO) and (ref.index <> R_NO) and
(ref.offset <> 0) Then Internalerror(58992);
if (ref.base = R_NO) Then
begin
ref.base := ref.index;
ref.index := R_NO
end
end;
procedure tcgppc.a_op_reg_reg_const32(list: PAasmOutput; OpLo, OpHi:
TAsmOp; reg1, reg2: TRegister; a: AWord);
{ Generates }
{ OpLo reg1, reg2, (a and $ffff) and/or }
{ OpHi reg1, reg2, (a shr 16) }
{ depending on the value of a }
Begin
if (a and $ffff) <> 0 Then
list^.concat(new(paicpu,op_reg_reg_const(OpLo,reg1,reg2,a and $ffff)));
If (a shr 16) <> 0 Then
list^.concat(new(paicpu,op_reg_reg_const(OpHi,reg1,reg2,a shr 16)))
End;
end.
{
{
$Id$
Copyright (c) 1993-98 by Florian Klaempfl
This unit implements the code generator for the PowerPC
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.
****************************************************************************
}
unit cgcpu;
interface
uses
cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo;
type
pcgppc = ^tcgppc;
tcgppc = object(tcg)
procedure a_call_name(list : paasmoutput;const s : string;
offset : longint);virtual;
procedure a_op_reg_const(list : paasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; a: AWord); virtual;
{ move instructions }
procedure a_load_const_reg(list : paasmoutput; size: tcgsize; a : aword;reg : tregister);virtual;
procedure a_load_reg_ref(list : paasmoutput; size: tcgsize; reg : tregister;const ref2 : treference);virtual;
procedure a_load_ref_reg(list : paasmoutput;size : tcgsize;const Ref2 : treference;reg : tregister);virtual;
procedure a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual;
{ comparison operations }
procedure a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : pasmlabel);virtual;
procedure a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel);
procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual;
procedure g_restore_frame_pointer(list : paasmoutput);virtual;
procedure tcgppc.g_return_from_proc(list : paasmoutput;parasize : aword);
procedure a_loadaddress_ref_reg(list : paasmoutput;const ref2 : treference;r : tregister);virtual;
procedure g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword;loadref : boolean);virtual;
private
procedure a_op_reg_reg_const32(list: PAasmOutPut; OpLo, OpHi: TAsmOp;
reg1, reg2: TRegister; a: AWord);
procedure fixref(var ref: treference);
end;
const
TOpCG2AsmOpLo: Array[TOpCG] of TAsmOp = (A_ADDI,A_ANDI_,A_DIVWU,
A_DIVW,A_MULLW, A_MULLW, A_NONE,A_NONE,A_ORI,
A_SRAWI,A_SLWI,A_SRWI,A_SUBI,A_XORI);
TOpCG2AsmOpHi: Array[TOpCG] of TAsmOp = (A_ADDIS,A_ANDIS_,
A_DIVWU,A_DIVW, A_MULLW,A_MULLW,A_NONE,A_NONE,
A_ORIS,A_NONE, A_NONE,A_NONE,A_SUBIS,A_XORIS);
TOpCmp2AsmCond: Array[topcmp] of TAsmCond = (C_EQ,C_GT,C_LT,C_GE,
C_LE,C_NE,C_LE,C_NG,C_GE,C_NL);
implementation
uses
globtype,globals,verbose;
procedure tcgppc.a_call_name(list : paasmoutput;const s : string;
offset : longint);
begin
{ save our RTOC register value. Only necessary when doing pointer based }
{ calls or cross TOC calls, but currently done always }
list^.concat(new(paicpu,op_reg_ref(A_STW,R_RTOC,
new_reference(stack_pointer,LA_RTOC))));
list^.concat(new(paicpu,op_sym(A_BL,newasmsymbol(s))));
list^.concat(new(paicpu,op_reg_ref(A_LWZ,R_RTOC,
new_reference(stack_pointer,LA_RTOC))));
end;
{********************** load instructions ********************}
procedure tcgppc.a_load_const_reg(list : paasmoutput; size: TCGSize; a : aword; reg : TRegister);
begin
If (a and $ffff) <> 0 Then
Begin
list^.concat(new(paicpu,op_reg_const(A_LI,reg,a and $ffff)));
If (a shr 16) <> 0 Then
list^.concat(new(paicpu,op_reg_const(A_ORIS,reg,a shr 16)))
End
Else
list^.concat(new(paicpu,op_reg_const(A_LIS,reg,a shr 16)));
end;
procedure tcgppc.a_load_reg_ref(list : paasmoutput; size: TCGSize; reg : tregister;const ref2 : treference);
Var
op: TAsmOp;
ref: TReference;
begin
ref := ref2;
FixRef(ref);
Case size of
OS_8 : op := A_STB;
OS_16: op := A_STH;
OS_32: op := A_STW;
Else InternalError(68993)
End;
list^.concat(new(paicpu,op_reg_ref(op,reg,newreference(ref))));
End;
procedure tcgppc.a_load_ref_reg(list : paasmoutput;size : tcgsize;const ref2: treference;reg : tregister);
Var
op: TAsmOp;
ref: TReference;
begin
ref := ref2;
FixRef(ref);
Case size of
OS_8 : op := A_LBZ;
OS_16: op := A_LHZ;
OS_32: op := A_LWZ
Else InternalError(68994)
End;
list^.concat(new(paicpu,op_reg_ref(op,reg,newreference(ref))));
end;
procedure tcgppc.a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);
begin
list^.concat(new(paicpu,op_reg_reg(A_MR,reg2,reg1)));
end;
procedure tcgppc.a_op_reg_const(list : paasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; a: AWord);
var scratch_register: TRegister;
begin
Case Op of
OP_DIV, OP_IDIV, OP_IMUL, OP_MUL:
If (Op = OP_IMUL) And (longint(a) >= -32768) And
(longint(a) <= 32767) Then
list^.concat(new(paicpu,op_reg_reg_const(A_MULLI,reg,reg,a)))
Else
Begin
scratch_register := get_scratch_reg(list);
a_load_const_reg(list, OS_32, a, scratch_register);
list^.concat(new(paicpu,op_reg_reg_reg(TOpCG2AsmOpLo[Op],
reg,reg,scratch_register)));
free_scratch_reg(list,scratch_register);
End;
OP_ADD, OP_AND, OP_OR, OP_SUB,OP_XOR:
a_op_reg_reg_const32(list,TOpCG2AsmOpLo[Op],
TOpCG2AsmOpHi[Op],reg,reg,a);
OP_SHL,OP_SHR,OP_SAR:
Begin
if (a and 31) <> 0 Then
list^.concat(new(paicpu,op_reg_reg_const(
TOpCG2AsmOpLo[Op],reg,reg,a and $ffff)));
If (a shr 5) <> 0 Then
InternalError(68991);
End
Else InternalError(68992);
end;
end;
{*************** compare instructructions ****************}
procedure tcgppc.a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : pasmlabel);
var AsmCond: TAsmCond;
scratch_register: TRegister;
signed: boolean;
begin
signed := cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE];
If signed Then
If (longint(a) >= -32768) and (longint(a) <= 32767) Then
list^.concat(new(paicpu,op_const_reg_const(A_CMPI,0,reg,a)))
else
begin
scratch_register := get_scratch_reg(list);
a_load_const_reg(list,OS_32,a,scratch_register);
list^.concat(new(paicpu,op_const_reg_reg(A_CMP,0,reg,scratch_register)));
free_scratch_reg(list,scratch_register);
end
else
if (a <= $ffff) then
list^.concat(new(paicpu,op_const_reg_const(A_CMPLI,0,reg,a)))
else
begin
scratch_register := get_scratch_reg(list);
a_load_const_reg(list,OS_32,a,scratch_register);
list^.concat(new(paicpu,op_const_reg_reg(A_CMPL,0,reg,scratch_register)));
free_scratch_reg(list,scratch_register);
end;
AsmCond := TOpCmp2AsmCond[cmp_op];
list^.concat(new(paicpu,op_const_const_sym(A_BC,AsmCond2BO[AsmCond],
AsmCond2BI[AsmCond],newasmsymbol(l^.name))));
end;
procedure tcgppc.a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;
reg1,reg2 : tregister;l : pasmlabel);
var AsmCond: TAsmCond;
begin
list^.concat(new(paicpu,op_const_reg_reg(A_CMPL,0,reg1,reg2)));
AsmCond := TOpCmp2AsmCond[cmp_op];
list^.concat(new(paicpu,op_const_const_sym(A_BC,AsmCond2BO[AsmCond],
AsmCond2BI[AsmCond],newasmsymbol(l^.name))));
end;
{ *********** entry/exit code and address loading ************ }
procedure tcgppc.g_stackframe_entry(list : paasmoutput;localsize : longint);
{ generated the entry code of a procedure/function. Note: localsize is the }
{ sum of the size necessary for local variables and the maximum possible }
{ combined size of ALL the parameters of a procedure called by the current }
{ one }
var scratch_register: TRegister;
begin
if (localsize mod 8) <> 0 then internalerror(58991);
{ CR and LR only have to be saved in case they are modified by the current }
{ procedure, but currently this isn't checked, so save them always }
scratch_register := get_scratch_reg(list);
list^.concat(new(paicpu,op_reg(A_MFCR,scratch_register)));
list^.concat(new(paicpu,op_reg_ref(A_STW,scratch_register,
new_reference(stack_pointer,LA_CR))));
free_scratch_reg(list,scratch_register);
scratch_register := get_scratch_reg(list);
list^.concat(new(paicpu,op_reg_reg(A_MFSPR,scratch_register,
R_LR)));
list^.concat(new(paicpu,op_reg_ref(A_STW,scratch_register,
new_reference(stack_pointer,LA_LR))));
free_scratch_reg(list,scratch_register);
{ if the current procedure is a leaf procedure, we can use the Red Zone, }
{ but this is not yet implemented }
{ if (procinfo.flags and pi_do_call) <> 0 Then}
Begin
if localsize<>0 then
begin
{ allocate space for the local variable, parameter and linkage area and }
{ save the stack pointer at the end of the linkage area }
if localsize <= $ffff Then
list^.concat(new(paicpu,op_reg_ref
(A_STWU,stack_pointer, new_reference(stack_pointer,localsize+
LinkageAreaSize))))
else
Begin
scratch_register := get_scratch_reg(list);
a_load_const_reg(list,OS_32,localsize,scratch_register);
list^.concat(new(paicpu,op_reg_reg_reg(A_STWUX,stack_pointer,
stack_pointer,scratch_register)));
free_scratch_reg(list,scratch_register);
End;
End
End;
end;
procedure tcgppc.g_restore_frame_pointer(list : paasmoutput);
begin
{ no frame pointer on the PowerPC }
end;
procedure tcgppc.g_return_from_proc(list : paasmoutput;parasize : aword);
begin
abstract;
end;
procedure tcgppc.a_loadaddress_ref_reg(list : paasmoutput;const ref2 : treference;r : tregister);
Var
ref: TReference;
begin
ref := ref2;
FixRef(ref);
If ref.offset <> 0 Then
If ref.base <> R_NO then
a_op_reg_reg_const32(list,A_ADDI,A_ADDIS,r,r,ref.offset)
{ FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never}
{ occurs, so now only ref.offset has to be loaded }
else a_load_const_reg(list, OS_32, ref.offset, r)
else
if ref.index <> R_NO Then
list^.concat(new(paicpu,op_reg_reg_reg(A_ADD,r,ref.base,ref.index)))
else list^.concat(new(paicpu,op_reg_reg(A_MR,r,ref.base)))
end;
{ ************* concatcopy ************ }
procedure tcgppc.g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword;loadref : boolean);virtual;
var
countreg, tempreg: TRegister;
src, dst: TReference;
lab: PAsmLabel;
count, count2: aword;
begin
{ make sure source and dest are valid }
src := fixreference(source);
dst := fixreference(dest);
reset_reference(src);
reset_reference(dst);
{ load the address of source into src.base }
src.base := get_scratch_reg(list);
if loadref then
a_load_ref_reg(list,OS_32,source,src.base)
else a_load_address_ref_reg(list,source,src.base);
{ load the address of dest into dst.base }
dst.base := get_scratch_reg(list);
a_load_address_ref_reg(list,dest,dst.base);
count := len div 4;
if count > 3 then
{ generate a loop }
begin
Inc(dst.offset,4);
Inc(src.offset,4);
a_op_reg_reg_const32(list,A_SUBI,A_NONE,src.base,src.base,4);
a_op_reg_reg_const32(list,A_SUBI,A_NONE,dst.base,dst.base,4);
countreg := get_scratch_reg(list);
a_load_const_reg(list,OS_32,count-1,countreg);
tempreg := get_scratch_reg(list);
getlabel(lab);
a_label(list, lab);
list^.concat(new(paicpu,op_reg_ref(A_LWZU,tempreg,
newreference(src)));
a_op_reg_reg_const32(list,A_CMPI,A_NONE,R_CR0,countreg,0);
list^.concat(new(paicpu,op_reg_ref(A_STWU,tempreg,
newreference(dst)));
a_op_reg_reg_const32(list,A_SUBI,A_NONE,countreg,countreg,1);
list^.concat(new(paicpu,op_const_const_sym(A_BC,AsmCond2BO[C_NE],
AsmCond2BI[C_NE],newasmsymbol(l^.name))));
free_scratch_reg(list,countreg);
end
else
{ unrolled loop }
begin
tempreg := get_scratch_reg(list);
for count2 := 1 to count do
begin
a_load_ref_reg(list,OS_32,src,tempreg);
a_load_reg_ref(list,OS_32,tempreg,dst);
inc(src.offset,4);
inc(dst.offset,4);
end
end;
{ copy the leftovers }
if (len and 2) <> 0 then
begin
a_load_ref_reg(list,OS_16,src,tempreg);
a_load_reg_ref(list,OS_16,tempreg,dst);
inc(src.offset,2);
inc(dst.offset,2);
end;
if (len and 1) <> 0 then
begin
a_load_ref_reg(list,OS_8,src,tempreg);
a_load_reg_ref(list,OS_8,tempreg,dst);
end;
free_scratch_reg(list,tempreg);
free_scratch_reg(list,src.base);
free_scratch_reg(list,dst.base);
end;
{***************** This is private property, keep out! :) *****************}
procedure tcgppc.fixref(var ref: treference);
{ Make sure ref is a valid reference for the PowerPC and sets the base to }
{ the value of the index if (base = R_NO). (Index <> R_NO) is not checked }
{ because the less conditional jumps, the better }
begin
If (ref.base <> R_NO) and (ref.index <> R_NO) and
(ref.offset <> 0) Then Internalerror(58992);
if (ref.base = R_NO) Then
begin
ref.base := ref.index;
ref.index := R_NO
end
end;
procedure tcgppc.a_op_reg_reg_const32(list: PAasmOutput; OpLo, OpHi:
TAsmOp; reg1, reg2: TRegister; a: AWord);
{ Generates }
{ OpLo reg1, reg2, (a and $ffff) and/or }
{ OpHi reg1, reg2, (a shr 16) }
{ depending on the value of a }
Begin
if (a and $ffff) <> 0 Then
list^.concat(new(paicpu,op_reg_reg_const(OpLo,reg1,reg2,a and $ffff)));
If (a shr 16) <> 0 Then
list^.concat(new(paicpu,op_reg_reg_const(OpHi,reg1,reg2,a shr 16)))
End;
end.
{
$Log$
Revision 1.3 1999-08-25 12:00:23 jonas
* changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
Revision 1.2 1999/08/18 17:05:57 florian
+ implemented initilizing of data for the new code generator
so it should compile now simple programs
Revision 1.1 1999/08/06 16:41:11 jonas
* PowerPC compiles again, several routines implemented in cgcpu.pas
* added constant to cpubase of alpha and powerpc for maximum
number of operands
}
Revision 1.4 1999-08-26 14:53:41 jonas
* first implementation of concatcopy (requires 4 scratch regs)
Revision 1.3 1999/08/25 12:00:23 jonas
* changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
Revision 1.2 1999/08/18 17:05:57 florian
+ implemented initilizing of data for the new code generator
so it should compile now simple programs
Revision 1.1 1999/08/06 16:41:11 jonas
* PowerPC compiles again, several routines implemented in cgcpu.pas
* added constant to cpubase of alpha and powerpc for maximum
number of operands
}