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

566
compiler/sparc/cpupara.pas
View File

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

122
compiler/sparc/cpupi.pas
View File

@ -1,4 +1,4 @@
{ {*****************************************************************************
$Id$ $Id$
Copyright (c) 2002 by Florian Klaempfl Copyright (c) 2002 by Florian Klaempfl
@ -18,78 +18,66 @@
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.
**************************************************************************** ****************************************************************************}
}
{ This unit contains the CPU specific part of tprocinfo. } { This unit contains the CPU specific part of tprocinfo. }
unit cpupi; unit cpupi;
{$INCLUDE fpcdefs.inc}
{$i fpcdefs.inc} interface
uses
interface cutils,
cgbase,cpuinfo;
uses type
cutils, TSparcprocinfo=class(TProcInfo)
cgbase,cpuinfo; {overall size of allocated stack space, currently this is used for the PowerPC only}
localsize:aword;
type {max. of space need for parameters, currently used by the PowerPC port only}
TSparcprocinfo = class(tprocinfo) maxpushedparasize:aword;
{ overall size of allocated stack space, currently this is used for the PowerPC only } constructor create;override;
localsize : aword; procedure after_header;override;
procedure after_pass1;override;
{ max. of space need for parameters, currently used by the PowerPC port only } end;
maxpushedparasize : aword; implementation
uses
constructor create;override; globtype,globals,
procedure after_header;override; aasmtai,
procedure after_pass1;override; tgobj;
end; constructor TSparcprocinfo.create;
begin
inherited create;
implementation maxpushedparasize:=0;
localsize:=0;
uses end;
globtype,globals, procedure TSparcprocinfo.after_header;
aasmtai, begin
tgobj; { this value is necessary for nested procedures }
procdef.localst.address_fixup:=align(procdef.parast.datasize,16);
constructor TSparcprocinfo.create; end;
procedure TSparcprocinfo.after_pass1;
begin begin
inherited create; procdef.parast.address_fixup:=align(maxpushedparasize,16);
maxpushedparasize:=0; if cs_asm_source in aktglobalswitches
localsize:=0; then
end; 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);
procedure TSparcprocinfo.after_header; if cs_asm_source in aktglobalswitches
begin then
{ this value is necessary for nested procedures } aktproccode.insert(Tai_comment.Create(strpnew('Locals start at: %o6+'+tostr(procdef.localst.address_fixup))));
procdef.localst.address_fixup:=align(procdef.parast.datasize,16); procinfo.firsttemp_offset:=align(procdef.localst.address_fixup+procdef.localst.datasize,16);
end; if cs_asm_source in aktglobalswitches
then
procedure TSparcprocinfo.after_pass1; aktproccode.insert(Tai_comment.Create(strpnew('Temp. space start: %o6+'+tostr(procinfo.firsttemp_offset))));
begin tg.firsttemp:=procinfo.firsttemp_offset;
procdef.parast.address_fixup:=align(maxpushedparasize,16); tg.lasttemp:=procinfo.firsttemp_offset;
if cs_asm_source in aktglobalswitches then end;
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;
begin begin
cprocinfo:=TSparcprocinfo; cprocinfo:=TSparcprocinfo;
end. end.
{ {
$Log$ $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 added support for SPARC processors
Revision 1.1 2002/08/23 10:08:28 mazen 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 Revision 1.1 2002/08/17 09:23:49 florian
* first part of procinfo rewrite * first part of procinfo rewrite
} }