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