diff --git a/compiler/sparc/cgcpu.pas b/compiler/sparc/cgcpu.pas index ec3d5fafbd..74dbbbd374 100644 --- a/compiler/sparc/cgcpu.pas +++ b/compiler/sparc/cgcpu.pas @@ -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] 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] 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 diff --git a/compiler/sparc/cpupara.pas b/compiler/sparc/cpupara.pas index 93f0c8a3a2..81a994add5 100644 --- a/compiler/sparc/cpupara.pas +++ b/compiler/sparc/cpupara.pas @@ -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 } diff --git a/compiler/sparc/cpupi.pas b/compiler/sparc/cpupi.pas index d6c362cf72..86e4a772cd 100644 --- a/compiler/sparc/cpupi.pas +++ b/compiler/sparc/cpupi.pas @@ -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 } - -