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

* Internal error fixed, but usually i386 parameter model used

Browse Source
This commit is contained in:
mazen 2002-10-10 15:10:39 +00:00
parent 1c642c2002
commit de41a87b82
3 changed files with 491 additions and 517 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

320
compiler/sparc/cgcpu.pas
View File

@ -9,7 +9,7 @@
{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
Copyright (c) 1998-2000 by Florian Klaempfl
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
@ -36,7 +36,7 @@ USES
node,symconst;
TYPE
tcgSPARC=CLASS(tcg)
FreeParamRegSet:TRegisterSet;
FreeParamRegSet:TRegisterSet;
{This method is used to pass a parameter, which is located in a register, to a
routine. It should give the parameter to the routine, as required by the
specific processor ABI. It is overriden for each CPU target.
@ -87,7 +87,7 @@ specific processor ABI. It is overriden for each CPU target.
procedure g_concatcopy(list:TAasmOutput;CONST source,dest:TReference;len:aword;delsource,loadref:boolean);override;
class function reg_cgsize(CONST reg:tregister):tcgsize;override;
PRIVATE
function IsSimpleRef(const ref:treference):boolean;
function IsSimpleRef(const ref:treference):boolean;
procedure sizes2load(s1:tcgsize;s2:topsize;var op:tasmop;var s3:topsize);
procedure floatload(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
procedure floatstore(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
@ -127,41 +127,40 @@ procedure tcgSPARC.a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST Loc
List.Concat(taicpu.op_const(A_LD,S_L,a));
END;
procedure tcgSPARC.a_param_ref(list:TAasmOutput;size:tcgsize;const r:TReference;const LocPara:TParaLocation);
var
ref: treference;
tmpreg:TRegister;
begin
if Size<>OS_32
then
InternalError(2002100400);
case locpara.loc of
LOC_REGISTER,LOC_CREGISTER:
a_load_ref_reg(list,size,r,locpara.register);
LOC_REFERENCE:
begin
reference_reset(ref);
ref.base:=locpara.reference.index;
ref.offset:=locpara.reference.offset;
tmpreg := get_scratch_reg_int(list);
a_load_ref_reg(list,size,r,tmpreg);
a_load_reg_ref(list,size,tmpreg,ref);
free_scratch_reg(list,tmpreg);
end;
LOC_FPUREGISTER,LOC_CFPUREGISTER:
case size of
OS_32:
a_loadfpu_ref_reg(list,OS_F32,r,locpara.register);
OS_64:
a_loadfpu_ref_reg(list,OS_F64,r,locpara.register);
else
internalerror(2002072801);
end;
else
internalerror(2002081103);
end;
if locpara.sp_fixup<>0
then
internalerror(2002081104);
var
ref: treference;
tmpreg:TRegister;
begin
case locpara.loc of
LOC_REGISTER,LOC_CREGISTER:
a_load_ref_reg(list,size,r,locpara.register);
LOC_REFERENCE:
begin
{Code conventions need the parameters being allocated in %o6+92. See
comment on g_stack_frame}
if locpara.sp_fixup<92
then
InternalError(2002081104);
reference_reset(ref);
ref.base:=locpara.reference.index;
ref.offset:=locpara.reference.offset;
tmpreg := get_scratch_reg_int(list);
a_load_ref_reg(list,size,r,tmpreg);
a_load_reg_ref(list,size,tmpreg,ref);
free_scratch_reg(list,tmpreg);
end;
LOC_FPUREGISTER,LOC_CFPUREGISTER:
case size of
OS_32:
a_loadfpu_ref_reg(list,OS_F32,r,locpara.register);
OS_64:
a_loadfpu_ref_reg(list,OS_F64,r,locpara.register);
else
internalerror(2002072801);
end;
else
internalerror(2002081103);
end;
end;
procedure tcgSPARC.a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST LocPara:TParaLocation);
VAR
@ -229,39 +228,39 @@ procedure tcgSPARC.a_load_reg_ref(list:TAasmOutput;size:TCGSize;reg:tregister;CO
list.concat(taicpu.op_reg_ref(A_LD,TCGSize2OpSize[size],reg,ref));
END;
procedure tcgSPARC.a_load_ref_reg(list:TAasmOutput;size:tcgsize;const ref:TReference;reg:tregister);
var
op:tasmop;
s:topsize;
begin
sizes2load(size,S_L,op,s);
list.concat(taicpu.op_ref_reg(op,s,ref,reg));
end;
var
op:tasmop;
s:topsize;
begin
sizes2load(size,S_L,op,s);
list.concat(taicpu.op_ref_reg(op,s,ref,reg));
end;
procedure tcgSPARC.a_load_reg_reg(list:TAasmOutput;fromsize,tosize:tcgsize;reg1,reg2:tregister);
var
op:tasmop;
s:topsize;
begin
if(reg1<>reg2)or
(tcgsize2size[tosize]<tcgsize2size[fromsize])or
((tcgsize2size[tosize] = tcgsize2size[fromsize])and
(tosize <> fromsize)and
not(fromsize in [OS_32,OS_S32]))
then
with list do
case fromsize of
OS_8:
InternalError(2002100800);{concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,reg2,reg1,0,31-8+1,31));}
OS_S8:
InternalError(2002100801);{concat(taicpu.op_reg_reg(A_EXTSB,reg2,reg1));}
OS_16:
InternalError(2002100802);{concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,reg2,reg1,0,31-16+1,31));}
OS_S16:
InternalError(2002100803);{concat(taicpu.op_reg_reg(A_EXTSH,reg2,reg1));}
OS_32,OS_S32:
concat(taicpu.op_reg_reg_reg(A_OR,S_L,R_G0,reg1,reg2));
else internalerror(2002090901);
end;
end;
var
op:tasmop;
s:topsize;
begin
if(reg1<>reg2)or
(tcgsize2size[tosize]<tcgsize2size[fromsize])or
((tcgsize2size[tosize] = tcgsize2size[fromsize])and
(tosize <> fromsize)and
not(fromsize in [OS_32,OS_S32]))
then
with list do
case fromsize of
OS_8:
InternalError(2002100800);{concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,reg2,reg1,0,31-8+1,31));}
OS_S8:
InternalError(2002100801);{concat(taicpu.op_reg_reg(A_EXTSB,reg2,reg1));}
OS_16:
InternalError(2002100802);{concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,reg2,reg1,0,31-16+1,31));}
OS_S16:
InternalError(2002100803);{concat(taicpu.op_reg_reg(A_EXTSH,reg2,reg1));}
OS_32,OS_S32:
concat(taicpu.op_reg_reg_reg(A_OR,S_L,R_G0,reg1,reg2));
else internalerror(2002090901);
end;
end;
{ all fpu load routines expect that R_ST[0-7] means an fpu regvar and }
{ R_ST means "the current value at the top of the fpu stack" (JM) }
procedure tcgSPARC.a_loadfpu_reg_reg(list:TAasmOutput;reg1, reg2:tregister);
@ -801,57 +800,57 @@ procedure tcgSPARC.g_stackframe_entry(list:TAasmOutput;localsize:LongInt);
again:tasmlabel;
begin
{According the the SPARC ABI the standard stack frame must include :
* 16 word save for the in and local registers in case of overflow/underflow.
* 16 word save for the in and local registers in case of overflow/underflow.
this save area always must exist at the %o6+0,
* software conventions requires space for the aggregate return value pointer, even if the word is not used,
* althogh the first six words of arguments reside in registers, the standard
* software conventions requires space for the aggregate return value pointer, even if the word is not used,
* althogh the first six words of arguments reside in registers, the standard
stack frame reserves space for them. Arguments beond the sixth reside on the
stack as in the Intel architecture,
* other areas depend on the compiler and the code being compiled. The
* other areas depend on the compiler and the code being compiled. The
standard calling sequence does not define a maximum stack frame size, nor does
it restrict how a language system uses the "unspecified" areas of the standard
stack frame.}
Dec(LocalSize,(16+1+5)*4);
Dec(LocalSize,(16+1+5)*4);
{Althogh the SPARC architecture require only word alignment, software
convention and the operating system require every stack frame to be double word
aligned}
LocalSize:=(LocalSize+3)and $FFFFFFFC;
LocalSize:=(LocalSize+3)and $FFFFFFFC;
{Execute the SAVE instruction to get a new register window and get a new stack
frame. In the "SAVE %i6,size,%i6" the first %i6 is related to the state before
execution of the SAVE instrucion so it is the caller %i6, when the %i6 after
execution of that instrucion is the called function stack pointer}
with list do
concat(Taicpu.Op_reg_const_reg(A_SAVE,S_L,Stack_Pointer_Reg,localsize,Stack_Pointer_Reg));
end;
with list do
concat(Taicpu.Op_reg_const_reg(A_SAVE,S_L,Stack_Pointer_Reg,localsize,Stack_Pointer_Reg));
end;
procedure tcgSPARC.g_restore_frame_pointer(list:TAasmOutput);
begin
begin
{This function intontionally does nothing as frame pointer is restored in the
delay slot of the return instrucion done in g_return_from_proc}
end;
end;
procedure tcgSPARC.g_return_from_proc(list:TAasmOutput;parasize:aword);
var
RetReference:TReference;
begin
var
RetReference:TReference;
begin
{According to the SPARC ABI, the stack is cleared using the RESTORE instruction
which is genereted in the g_restore_frame_pointer. Notice that SPARC has no
RETURN instruction and that JMPL is used instead. The JMPL instrucion have one
delay slot, so an inversion is possible such as
JMPL %i6+8,%g0
RESTORE %g0,0,%g0
JMPL %i6+8,%g0
RESTORE %g0,0,%g0
If no inversion we can use just
RESTORE %g0,0,%g0
JMPL %i6+8,%g0
NOP}
with list do
begin
RESTORE %g0,0,%g0
JMPL %i6+8,%g0
NOP}
with list do
begin
{Return address is computed by adding 8 to the CALL address saved onto %i6}
reference_reset_base(RetReference,R_I7,8);
concat(Taicpu.Op_ref_reg(A_JMPL,S_L,RetReference,R_G0));
reference_reset_base(RetReference,R_I7,8);
concat(Taicpu.Op_ref_reg(A_JMPL,S_L,RetReference,R_G0));
{We use trivial restore in the delay slot of the JMPL instruction, as we
already set result onto %i0}
concat(Taicpu.Op_reg_const_reg(A_RESTORE,S_L,R_G0,0,R_G0));
end
end;
concat(Taicpu.Op_reg_const_reg(A_RESTORE,S_L,R_G0,0,R_G0));
end
end;
procedure tcgSPARC.a_loadaddr_ref_reg(list:TAasmOutput;CONST ref:TReference;r:tregister);
begin
@ -970,17 +969,17 @@ procedure tcgSPARC.a_loadaddr_ref_reg(list:TAasmOutput;CONST ref:TReference;r:tr
{ ************* concatcopy ************ }
procedure TCgSparc.g_concatcopy(list:taasmoutput;const source,dest:treference;len:aword;delsource,loadref:boolean);
var
countreg: TRegister;
src, dst: TReference;
lab: tasmlabel;
count, count2: aword;
orgsrc, orgdst: boolean;
begin
var
countreg: TRegister;
src, dst: TReference;
lab: tasmlabel;
count, count2: aword;
orgsrc, orgdst: boolean;
begin
{$ifdef extdebug}
if len > high(longint)
then
internalerror(2002072704);
if len > high(longint)
then
internalerror(2002072704);
{$endif extdebug}
{ make sure short loads are handled as optimally as possible }
if not loadref then
@ -1134,60 +1133,60 @@ function tcgSPARC.reg_cgsize(CONST reg:tregister):tcgsize;
{***************** This is private property, keep out! :) *****************}
function TCgSparc.IsSimpleRef(const ref:treference):boolean;
begin
if(ref.base=R_NONE)and(ref.index <> R_NO)
then
InternalError(2002100804);
begin
if(ref.base=R_NONE)and(ref.index <> R_NO)
then
InternalError(2002100804);
result :=not(assigned(ref.symbol))and
(((ref.index = R_NO) and
(ref.offset >= low(smallint)) and
(ref.offset <= high(smallint))) or
((ref.index <> R_NO) and
(ref.offset = 0)));
end;
(((ref.index = R_NO) and
(ref.offset >= low(smallint)) and
(ref.offset <= high(smallint))) or
((ref.index <> R_NO) and
(ref.offset = 0)));
end;
procedure tcgSPARC.sizes2load(s1:tcgsize;s2:topsize;var op:tasmop;var s3:topsize);
begin
case s2 of
S_B:
if S1 in [OS_8,OS_S8]
then
s3 := S_B
else
internalerror(200109221);
S_W:
case s1 of
OS_8,OS_S8:
s3 := S_BW;
OS_16,OS_S16:
s3 := S_W;
else
internalerror(200109222);
end;
S_L:
case s1 of
OS_8,OS_S8:
s3 := S_BL;
OS_16,OS_S16:
s3 := S_WL;
OS_32,OS_S32:
s3 := S_L;
else
internalerror(200109223);
end;
else internalerror(200109227);
end;
if s3 in [S_B,S_W,S_L]
then
op := A_LD
{ else if s3=S_DW
then
op:=A_LDD
else if s3 in [OS_8,OS_16,OS_32]
then
op := A_NONE}
else
op := A_NONE;
end;
begin
case s2 of
S_B:
if S1 in [OS_8,OS_S8]
then
s3 := S_B
else
internalerror(200109221);
S_W:
case s1 of
OS_8,OS_S8:
s3 := S_BW;
OS_16,OS_S16:
s3 := S_W;
else
internalerror(200109222);
end;
S_L:
case s1 of
OS_8,OS_S8:
s3 := S_BL;
OS_16,OS_S16:
s3 := S_WL;
OS_32,OS_S32:
s3 := S_L;
else
internalerror(200109223);
end;
else internalerror(200109227);
end;
if s3 in [S_B,S_W,S_L]
then
op := A_LD
{ else if s3=S_DW
then
op:=A_LDD
else if s3 in [OS_8,OS_16,OS_32]
then
op := A_NONE}
else
op := A_NONE;
end;
procedure tcgSPARC.floatloadops(t:tcgsize;VAR op:tasmop;VAR s:topsize);
BEGIN
(* case t of
@ -1257,7 +1256,10 @@ BEGIN
END.
{
$Log$
Revision 1.12 2002-10-08 17:17:03 mazen
Revision 1.13 2002-10-10 15:10:39 mazen
* Internal error fixed, but usually i386 parameter model used
Revision 1.12 2002/10/08 17:17:03 mazen
*** empty log message ***
Revision 1.11 2002/10/07 20:33:04 mazen

566
compiler/sparc/cpupara.pas
View File

@ -1,319 +1,305 @@
{*****************************************************************************}
{ File : cpupara.pas }
{ Author : Mazen NEIFER }
{ Project : Free Pascal Compiler (FPC) }
{ Creation date : 2002\07\13 }
{ Last modification date : 2002\08\20 }
{ Licence : GPL }
{ Bug report : mazen.neifer.01@supaero.org }
{*****************************************************************************}
{
$Id$
Copyright (c) 2002 by Florian Klaempfl
{******************************************************************************
$Id$
Copyright (c) 2002 by Florian Klaempfl
PowerPC specific calling conventions
PowerPC specific calling conventions
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 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.
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.
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 cpupara;
{SPARC specific calling conventions are handled by this unit}
{$INCLUDE fpcdefs.inc}
interface
uses
cpubase,
symconst,symbase,symtype,symdef,paramgr;
cpubase,
symconst,symbase,symtype,symdef,paramgr;
type
TSparcParaManager=class(TParaManager)
function GetIntParaLoc(nr:longint):TParaLocation;override;
procedure create_param_loc_info(p:TAbstractProcDef);override;
function GetFuncRetParaLoc(p:TAbstractProcDef):TParaLocation;override;
end;
TSparcParaManager=class(TParaManager)
function GetIntParaLoc(nr:longint):TParaLocation;override;
procedure create_param_loc_info(p:TAbstractProcDef);override;
function GetFuncRetParaLoc(p:TAbstractProcDef):TParaLocation;override;
end;
implementation
uses
verbose,
globtype,
cpuinfo,cginfo,cgbase,
defbase;
verbose,
globtype,
cpuinfo,cginfo,cgbase,
defbase;
function TSparcParaManager.GetIntParaLoc(nr:longint):TParaLocation;
begin
if nr<1
then
InternalError(2002100806);
FillChar(Result,SizeOf(TParaLocation),0);
Dec(nr);
with Result do
if nr<6
then{The six first parameters are passed into registers}
begin
loc:=LOC_REGISTER;
register:=TRegister(LongInt(R_O0)+nr);
WriteLn('-------------------------------------------');
end
else{The other parameters are passed into the frame}
begin
loc:=LOC_REFERENCE;
reference.index:=frame_pointer_reg;
reference.offset:=-92-(nr-6)*4;
WriteLn('+++++++++++++++++++++++++++++++++++++++++++');
end;
end;
begin
if nr<1
then
InternalError(2002100806);
FillChar(Result,SizeOf(TParaLocation),0);
Dec(nr);
with Result do
if nr<6
then{The six first parameters are passed into registers}
begin
loc:=LOC_REGISTER;
register:=TRegister(LongInt(R_O0)+nr);
WriteLn('-------------------------------------------');
end
else{The other parameters are passed into the frame}
begin
loc:=LOC_REFERENCE;
reference.index:=frame_pointer_reg;
reference.offset:=-92-(nr-6)*4;
WriteLn('+++++++++++++++++++++++++++++++++++++++++++');
end;
end;
function GetParaLoc(p:TDef):TLoc;
begin
begin
{Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER if
push_addr_param for the def is true}
case p.DefType of
OrdDef:
GetParaLoc:=LOC_REGISTER;
FloatDef:
GetParaLoc:=LOC_FPUREGISTER;
enumdef:
getparaloc:=LOC_REGISTER;
pointerdef:
getparaloc:=LOC_REGISTER;
formaldef:
getparaloc:=LOC_REGISTER;
classrefdef:
getparaloc:=LOC_REGISTER;
recorddef:
getparaloc:=LOC_REFERENCE;
objectdef:
if is_object(p) then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
stringdef:
if is_shortstring(p) or is_longstring(p) then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
procvardef:
if (po_methodpointer in tprocvardef(p).procoptions) then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
filedef:
getparaloc:=LOC_REGISTER;
arraydef:
getparaloc:=LOC_REFERENCE;
setdef:
if is_smallset(p) then
getparaloc:=LOC_REGISTER
else
getparaloc:=LOC_REFERENCE;
variantdef:
getparaloc:=LOC_REFERENCE;
{ avoid problems with errornous definitions }
errordef:
getparaloc:=LOC_REGISTER;
else
internalerror(2002071001);
end;
end;
case p.DefType of
OrdDef:
GetParaLoc:=LOC_REGISTER;
FloatDef:
GetParaLoc:=LOC_FPUREGISTER;
enumdef:
getparaloc:=LOC_REGISTER;
pointerdef:
getparaloc:=LOC_REGISTER;
formaldef:
getparaloc:=LOC_REGISTER;
classrefdef:
getparaloc:=LOC_REGISTER;
recorddef:
getparaloc:=LOC_REFERENCE;
objectdef:
if is_object(p)
then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
stringdef:
if is_shortstring(p) or is_longstring(p)
then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
procvardef:
if (po_methodpointer in tprocvardef(p).procoptions)
then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
filedef:
getparaloc:=LOC_REGISTER;
arraydef:
getparaloc:=LOC_REFERENCE;
setdef:
if is_smallset(p)
then
getparaloc:=LOC_REGISTER
else
getparaloc:=LOC_REFERENCE;
variantdef:
getparaloc:=LOC_REFERENCE;
{ avoid problems with errornous definitions }
errordef:
getparaloc:=LOC_REGISTER;
else
internalerror(2002071001);
end;
end;
procedure TSparcParaManager.create_param_loc_info(p:tabstractprocdef);
var
nextintreg,nextfloatreg,nextmmreg : tregister;
stack_offset : aword;
hp : tparaitem;
loc : tloc;
is_64bit: boolean;
begin
nextintreg:=R_O0;
nextfloatreg:=R_F0;
nextmmreg:=R_NONE;
stack_offset:=92;
{pointer for structured results ?}
if not is_void(p.RetType.def)
then
if not(ret_in_reg(p.rettype.def))
then
inc(nextintreg);
{frame pointer for nested procedures?}
{ inc(nextintreg); }
{ constructor? }
{ destructor? }
var
nextintreg,nextfloatreg:tregister;
stack_offset : aword;
hp : tparaitem;
loc : tloc;
is_64bit: boolean;
begin
nextintreg:=R_O0;
nextfloatreg:=R_F0;
stack_offset:=92;
WriteLn('***********************************************');
hp:=TParaItem(p.para.last);
while assigned(hp) do
begin
loc:=GetParaLoc(hp.paratype.def);
hp.paraloc.sp_fixup:=0;
case loc of
LOC_REGISTER:
begin
hp.paraloc.size:=def_cgSize(hp.paratype.def);
if hp.paraloc.size=OS_NO
then
hp.paraloc.size:=OS_ADDR;
is_64bit:=hp.paraloc.size in [OS_64,OS_S64];
if NextIntReg<=TRegister(ord(R_O5)-ord(is_64bit))
then
begin
WriteLn('Allocating ',std_reg2str[NextIntReg]);
hp.paraloc.loc:=LOC_REGISTER;
hp.paraloc.registerlow:=NextIntReg;
inc(NextIntReg);
if is_64bit
then
begin
hp.paraloc.registerhigh:=nextintreg;
inc(nextintreg);
end;
end
else
begin
nextintreg:=R_O6;
hp.paraloc.loc:=LOC_REFERENCE;
hp.paraloc.reference.index:=stack_pointer_reg;
hp.paraloc.reference.offset:=stack_offset;
if not is_64bit
then
inc(stack_offset,4)
else
inc(stack_offset,8);
end;
end;
LOC_FPUREGISTER:
begin
if hp.paratyp in [vs_var,vs_out] then
begin
if nextintreg<=R_O5 then
begin
hp.paraloc.size:=OS_ADDR;
hp.paraloc.loc:=LOC_REGISTER;
hp.paraloc.register:=nextintreg;
inc(nextintreg);
end
else
begin
{!!!!!!!}
hp.paraloc.size:=def_cgsize(hp.paratype.def);
internalerror(2002071006);
end;
end
else if nextfloatreg<=R_F10 then
begin
hp.paraloc.size:=def_cgsize(hp.paratype.def);
hp.paraloc.loc:=LOC_FPUREGISTER;
hp.paraloc.register:=nextfloatreg;
inc(nextfloatreg);
end
else
begin
{!!!!!!!}
hp.paraloc.size:=def_cgsize(hp.paratype.def);
internalerror(2002071004);
end;
end;
LOC_REFERENCE:
begin
hp.paraloc.size:=OS_ADDR;
if push_addr_param(hp.paratype.def,p.proccalloption in [pocall_cdecl,pocall_cppdecl]) or (hp.paratyp in [vs_var,vs_out]) then
begin
if nextintreg<=R_O5 then
begin
hp.paraloc.loc:=LOC_REGISTER;
hp.paraloc.register:=nextintreg;
inc(nextintreg);
end
else
begin
hp.paraloc.loc:=LOC_REFERENCE;
hp.paraloc.reference.index:=stack_pointer_reg;
hp.paraloc.reference.offset:=stack_offset;
inc(stack_offset,4);
end;
end
else
begin
hp.paraloc.loc:=LOC_REFERENCE;
hp.paraloc.reference.index:=stack_pointer_reg;
hp.paraloc.reference.offset:=stack_offset;
inc(stack_offset,hp.paratype.def.size);
end;
end;
else
internalerror(2002071002);
end;
hp:=TParaItem(hp.previous);
end;
end;
hp:=TParaItem(p.para.First);
while assigned(hp) do
begin
loc:=GetParaLoc(hp.paratype.def);
case loc of
LOC_REGISTER:
begin
hp.paraloc.size:=def_cgSize(hp.paratype.def);
if hp.paraloc.size=OS_NO
then
hp.paraloc.size:=OS_ADDR;
is_64bit:=hp.paraloc.size in [OS_64,OS_S64];
if NextIntReg<=TRegister(ord(R_O5)-ord(is_64bit))
then
begin
WriteLn('Allocating ',std_reg2str[NextIntReg]);
hp.paraloc.loc:=LOC_REGISTER;
hp.paraloc.registerlow:=NextIntReg;
inc(NextIntReg);
if is_64bit
then
begin
hp.paraloc.registerhigh:=nextintreg;
inc(nextintreg);
end;
end
else
begin
nextintreg:=R_O6;
hp.paraloc.loc:=LOC_REFERENCE;
hp.paraloc.reference.index:=stack_pointer_reg;
hp.paraloc.reference.offset:=stack_offset;
if not is_64bit
then
inc(stack_offset,4)
else
inc(stack_offset,8);
end;
end;
LOC_FPUREGISTER:
begin
if hp.paratyp in [vs_var,vs_out] then
begin
if nextintreg<=R_O5 then
begin
hp.paraloc.size:=OS_ADDR;
hp.paraloc.loc:=LOC_REGISTER;
hp.paraloc.register:=nextintreg;
inc(nextintreg);
end
else
begin
{!!!!!!!}
hp.paraloc.size:=def_cgsize(hp.paratype.def);
internalerror(2002071006);
end;
end
else if nextfloatreg<=R_F10 then
begin
hp.paraloc.size:=def_cgsize(hp.paratype.def);
hp.paraloc.loc:=LOC_FPUREGISTER;
hp.paraloc.register:=nextfloatreg;
inc(nextfloatreg);
end
else
begin
{!!!!!!!}
hp.paraloc.size:=def_cgsize(hp.paratype.def);
internalerror(2002071004);
end;
end;
LOC_REFERENCE:
begin
hp.paraloc.size:=OS_ADDR;
if push_addr_param(hp.paratype.def,p.proccalloption in [pocall_cdecl,pocall_cppdecl]) or (hp.paratyp in [vs_var,vs_out]) then
begin
if nextintreg<=R_O5 then
begin
hp.paraloc.loc:=LOC_REGISTER;
hp.paraloc.register:=nextintreg;
inc(nextintreg);
end
else
begin
hp.paraloc.loc:=LOC_REFERENCE;
hp.paraloc.reference.index:=stack_pointer_reg;
hp.paraloc.reference.offset:=stack_offset;
inc(stack_offset,4);
end;
end
else
begin
hp.paraloc.loc:=LOC_REFERENCE;
hp.paraloc.reference.index:=stack_pointer_reg;
hp.paraloc.reference.offset:=stack_offset;
inc(stack_offset,hp.paratype.def.size);
end;
end;
else
internalerror(2002071002);
end;
hp:=TParaItem(hp.Next);
end;
end;
function tSparcParaManager.GetFuncRetParaLoc(p:TAbstractProcDef):TParaLocation;
begin
case p.rettype.def.deftype of
orddef,enumdef:
begin
WriteLn('Allocating i0 as return register');
GetFuncRetParaLoc.loc:=LOC_REGISTER;
GetFuncRetParaLoc.register:=R_i0;
GetFuncRetParaLoc.size:=def_cgsize(p.rettype.def);
if GetFuncRetParaLoc.size in [OS_S64,OS_64]
then
GetFuncRetParaLoc.RegisterHigh:=R_O1;
end;
floatdef:
begin
GetFuncRetParaLoc.loc:=LOC_FPUREGISTER;
GetFuncRetParaLoc.register:=R_F1;
GetFuncRetParaLoc.size:=def_cgsize(p.rettype.def);
end;
{ smallsets are OS_INT in R3, others are OS_ADDR in R3 -> the same }
{ ugly, I know :) (JM) }
setdef,
variantdef,
pointerdef,
formaldef,
classrefdef,
recorddef,
objectdef,
stringdef,
procvardef,
filedef,
arraydef,
errordef:
begin
GetFuncRetParaLoc.loc:=LOC_REGISTER;
GetFuncRetParaLoc.register:=R_O0;
GetFuncRetParaLoc.size:=OS_ADDR;
end;
else
internalerror(2002090903);
end;
end;
begin
case p.rettype.def.deftype of
orddef,enumdef:
begin
WriteLn('Allocating i0 as return register');
GetFuncRetParaLoc.loc:=LOC_REGISTER;
GetFuncRetParaLoc.register:=R_i0;
GetFuncRetParaLoc.size:=def_cgsize(p.rettype.def);
if GetFuncRetParaLoc.size in [OS_S64,OS_64]
then
GetFuncRetParaLoc.RegisterHigh:=R_O1;
end;
floatdef:
begin
GetFuncRetParaLoc.loc:=LOC_FPUREGISTER;
GetFuncRetParaLoc.register:=R_F1;
GetFuncRetParaLoc.size:=def_cgsize(p.rettype.def);
end;
{ smallsets are OS_INT in R3, others are OS_ADDR in R3 -> the same }
{ ugly, I know :) (JM) }
setdef,
variantdef,
pointerdef,
formaldef,
classrefdef,
recorddef,
objectdef,
stringdef,
procvardef,
filedef,
arraydef,
errordef:
begin
GetFuncRetParaLoc.loc:=LOC_REGISTER;
GetFuncRetParaLoc.register:=R_O0;
GetFuncRetParaLoc.size:=OS_ADDR;
end;
else
internalerror(2002090903);
end;
end;
begin
ParaManager:=TSparcParaManager.create;
ParaManager:=TSparcParaManager.create;
end.
{
$Log$
Revision 1.5 2002-10-09 13:52:19 mazen
just incase some one wolud help me debugging that\!
$Log$
Revision 1.6 2002-10-10 15:10:39 mazen
* Internal error fixed, but usually i386 parameter model used
Revision 1.4 2002/10/08 21:02:22 mazen
* debugging register allocation
Revision 1.3 2002/10/07 20:33:05 mazen
word alignement modified in g_stack_frame
Revision 1.5 2002/10/09 13:52:19 mazen
just incase some one wolud help me debugging that\!
Revision 1.4 2002/10/08 21:02:22 mazen
* debugging register allocation
Revision 1.3 2002/10/07 20:33:05 mazen
word alignement modified in g_stack_frame
Revision 1.2 2002/10/04 21:57:42 mazen
* register allocation for parameters now done in cpupara, but InternalError(200109223) in cgcpu.pas:1053 is still not fixed du to location_force problem in ncgutils.pas:419
Revision 1.2 2002/10/04 21:57:42 mazen
* register allocation for parameters now done in cpupara, but InternalError(200109223) in cgcpu.pas:1053 is still not fixed du to location_force problem in ncgutils.pas:419
Revision 1.1 2002/08/21 13:30:07 mazen
*** empty log message ***
Revision 1.1 2002/08/21 13:30:07 mazen
*** empty log message ***
Revision 1.2 2002/07/11 14:41:34 florian
* start of the new generic parameter handling
Revision 1.2 2002/07/11 14:41:34 florian
* start of the new generic parameter handling
Revision 1.1 2002/07/07 09:44:32 florian
* powerpc target fixed, very simple units can be compiled
Revision 1.1 2002/07/07 09:44:32 florian
* powerpc target fixed, very simple units can be compiled
}

122
compiler/sparc/cpupi.pas
View File

@ -1,4 +1,4 @@
{
{*****************************************************************************
$Id$
Copyright (c) 2002 by Florian Klaempfl
@ -18,78 +18,66 @@
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
****************************************************************************}
{ This unit contains the CPU specific part of tprocinfo. }
unit cpupi;
{$i fpcdefs.inc}
interface
uses
cutils,
cgbase,cpuinfo;
type
TSparcprocinfo = class(tprocinfo)
{ overall size of allocated stack space, currently this is used for the PowerPC only }
localsize : aword;
{ max. of space need for parameters, currently used by the PowerPC port only }
maxpushedparasize : aword;
constructor create;override;
procedure after_header;override;
procedure after_pass1;override;
end;
implementation
uses
globtype,globals,
aasmtai,
tgobj;
constructor TSparcprocinfo.create;
begin
inherited create;
maxpushedparasize:=0;
localsize:=0;
end;
procedure TSparcprocinfo.after_header;
begin
{ this value is necessary for nested procedures }
procdef.localst.address_fixup:=align(procdef.parast.datasize,16);
end;
procedure TSparcprocinfo.after_pass1;
begin
procdef.parast.address_fixup:=align(maxpushedparasize,16);
if cs_asm_source in aktglobalswitches then
aktproccode.insert(Tai_comment.Create(strpnew('Parameter copies start at: r1+'+tostr(procdef.parast.address_fixup))));
procdef.localst.address_fixup:=align(procdef.parast.address_fixup+procdef.parast.datasize,16);
if cs_asm_source in aktglobalswitches then
aktproccode.insert(Tai_comment.Create(strpnew('Locals start at: r1+'+tostr(procdef.localst.address_fixup))));
procinfo.firsttemp_offset:=align(procdef.localst.address_fixup+procdef.localst.datasize,16);
if cs_asm_source in aktglobalswitches then
aktproccode.insert(Tai_comment.Create(strpnew('Temp. space start: r1+'+tostr(procinfo.firsttemp_offset))));
//!!!! tg.setfirsttemp(procinfo.firsttemp_offset);
tg.firsttemp:=procinfo.firsttemp_offset;
tg.lasttemp:=procinfo.firsttemp_offset;
end;
{$INCLUDE fpcdefs.inc}
interface
uses
cutils,
cgbase,cpuinfo;
type
TSparcprocinfo=class(TProcInfo)
{overall size of allocated stack space, currently this is used for the PowerPC only}
localsize:aword;
{max. of space need for parameters, currently used by the PowerPC port only}
maxpushedparasize:aword;
constructor create;override;
procedure after_header;override;
procedure after_pass1;override;
end;
implementation
uses
globtype,globals,
aasmtai,
tgobj;
constructor TSparcprocinfo.create;
begin
inherited create;
maxpushedparasize:=0;
localsize:=0;
end;
procedure TSparcprocinfo.after_header;
begin
{ this value is necessary for nested procedures }
procdef.localst.address_fixup:=align(procdef.parast.datasize,16);
end;
procedure TSparcprocinfo.after_pass1;
begin
procdef.parast.address_fixup:=align(maxpushedparasize,16);
if cs_asm_source in aktglobalswitches
then
aktproccode.insert(Tai_comment.Create(strpnew('Parameter copies start at: %i6+'+tostr(procdef.parast.address_fixup))));
procdef.localst.address_fixup:=align(procdef.parast.address_fixup+procdef.parast.datasize,16);
if cs_asm_source in aktglobalswitches
then
aktproccode.insert(Tai_comment.Create(strpnew('Locals start at: %o6+'+tostr(procdef.localst.address_fixup))));
procinfo.firsttemp_offset:=align(procdef.localst.address_fixup+procdef.localst.datasize,16);
if cs_asm_source in aktglobalswitches
then
aktproccode.insert(Tai_comment.Create(strpnew('Temp. space start: %o6+'+tostr(procinfo.firsttemp_offset))));
tg.firsttemp:=procinfo.firsttemp_offset;
tg.lasttemp:=procinfo.firsttemp_offset;
end;
begin
cprocinfo:=TSparcprocinfo;
end.
{
$Log$
Revision 1.2 2002-08-29 11:02:36 mazen
Revision 1.3 2002-10-10 15:10:39 mazen
* Internal error fixed, but usually i386 parameter model used
Revision 1.2 2002/08/29 11:02:36 mazen
added support for SPARC processors
Revision 1.1 2002/08/23 10:08:28 mazen
@ -104,5 +92,3 @@ end.
Revision 1.1 2002/08/17 09:23:49 florian
* first part of procinfo rewrite
}