diff --git a/compiler/sparc/tgcpu.pas b/compiler/sparc/tgcpu.pas deleted file mode 100644 index 652ff558f9..0000000000 --- a/compiler/sparc/tgcpu.pas +++ /dev/null @@ -1,699 +0,0 @@ -{ - $Id$ - Copyright (C) 1998-2000 by Florian Klaempfl - - This unit handles the temporary variables stuff for i386 - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit tgcpu; - -{$INCLUDE fpcdefs.inc} - -interface - - uses - globals, - cgbase,verbose,aasm, - node, - cpubase,cpuasm - ; - - type - tregisterset = set of tregister; - - tpushed = array[R_EAX..R_MM6] of boolean; - tsaved = array[R_EAX..R_MM6] of longint; - - const - usablereg32 : byte = 4; - - { this value is used in tsaved, if the register isn't saved } - reg_not_saved = $7fffffff; -{$ifdef SUPPORT_MMX} - usableregmmx : byte = 8; -{$endif SUPPORT_MMX} - - var - { tries to hold the amount of times which the current tree is processed } - t_times : longint; - -{$ifdef TEMPREGDEBUG} - procedure testregisters32; -{$endif TEMPREGDEBUG} - function getregisterint : tregister; - function getaddressregister: tregister; - procedure ungetregister32(r : tregister); - { tries to allocate the passed register, if possible } - function getexplicitregister32(r : tregister) : tregister; -{$ifdef SUPPORT_MMX} - function getregistermmx : tregister; - procedure ungetregistermmx(r : tregister); -{$endif SUPPORT_MMX} - - function isaddressregister(reg: tregister): boolean; - - procedure ungetregister(r : tregister); - - procedure cleartempgen; - procedure del_reference(const ref : treference); - procedure del_locref(const location : tlocation); - procedure del_location(const l : tlocation); - - { pushs and restores registers } - procedure pushusedregisters(var pushed : tpushed;b : byte); - procedure popusedregisters(const pushed : tpushed); - - { saves register variables (restoring happens automatically (JM) } - procedure saveregvars(b: byte); - - { saves and restores used registers to temp. values } - procedure saveusedregisters(var saved : tsaved;b : byte); - procedure restoreusedregisters(const saved : tsaved); - - { increments the push count of all registers in b} - procedure incrementregisterpushed(b : byte); - - procedure clearregistercount; - procedure resetusableregisters; - - { corrects the fpu stack register by ofs } - function correct_fpuregister(r : tregister;ofs : byte) : tregister; - - type -{$ifdef SUPPORT_MMX} - regvar_longintarray = array[R_EAX..R_MM6] of longint; - regvar_booleanarray = array[R_EAX..R_MM6] of boolean; - regvar_ptreearray = array[R_EAX..R_MM6] of tnode; -{$else SUPPORT_MMX} - regvar_longintarray = array[R_EAX..R_EDI] of longint; - regvar_booleanarray = array[R_EAX..R_EDI] of boolean; - regvar_ptreearray = array[R_EAX..R_EDI] of tnode; -{$endif SUPPORT_MMX} - - var - unused,usableregs : tregisterset; - c_usableregs : longint; - - { uses only 1 byte while a set uses in FPC 32 bytes } - usedinproc : byte; - - fpuvaroffset : byte; - - { count, how much a register must be pushed if it is used as register } - { variable } - reg_pushes : regvar_longintarray; - is_reg_var : regvar_booleanarray; - regvar_loaded: regvar_booleanarray; - -{$ifdef TEMPREGDEBUG} - reg_user : regvar_ptreearray; - reg_releaser : regvar_ptreearray; -{$endif TEMPREGDEBUG} - - -implementation - - uses - globtype,temp_gen,tainst,regvars; - - procedure incrementregisterpushed(b : byte); - - var - regi : tregister; - - begin - for regi:=R_EAX to R_EDI do - begin - if (b and ($80 shr word(regi)))<>0 then - inc(reg_pushes[regi],t_times*2); - end; - end; - - procedure pushusedregisters(var pushed : tpushed;b : byte); - - var - r : tregister; -{$ifdef SUPPORT_MMX} - hr : preference; -{$endif} - begin - usedinproc:=usedinproc or b; - for r:=R_EAX to R_EBX do - begin - pushed[r]:=false; - { if the register is used by the calling subroutine } - if ((b and ($80 shr byte(r)))<>0) then - begin - { and is present in use } - if not is_reg_var[r] then - if not(r in unused) then - begin - { then save it } - exprasmlist.concat(Taicpu.Op_reg(A_PUSH,S_L,r)); - - { here was a big problem !!!!!} - { you cannot do that for a register that is - globally assigned to a var - this also means that you must push it much more - often, but there must be a better way - maybe by putting the value back to the stack !! } - if not(is_reg_var[r]) then - begin - unused:=unused+[r]; -{$ifdef TEMPREGDEBUG} - inc(usablereg32); -{$endif TEMPREGDEBUG} - end; - pushed[r]:=true; - end; - end; - end; -{$ifdef SUPPORT_MMX} - for r:=R_MM0 to R_MM6 do - begin - pushed[r]:=false; - { if the mmx register is in use, save it } - if not(r in unused) then - begin - exprasmList.concat(Taicpu.Op_const_reg(A_SUB,S_L,8,R_ESP)); - new(hr); - reset_reference(hr^); - hr^.base:=R_ESP; - exprasmList.concat(Taicpu.Op_reg_ref(A_MOVQ,S_NO,r,hr)); - if not(is_reg_var[r]) then - begin - unused:=unused+[r]; -{$ifdef TEMPREGDEBUG} - inc(usableregmmx); -{$endif TEMPREGDEBUG} - end; - pushed[r]:=true; - end; - end; -{$endif SUPPORT_MMX} -{$ifdef TEMPREGDEBUG} - testregisters32; -{$endif TEMPREGDEBUG} - end; - - - procedure saveregvars(b: byte); - - var - r : tregister; - - begin - if not(cs_regalloc in aktglobalswitches) then - exit; - for r:=R_EAX to R_EBX do - { if the register is used by the calling subroutine } - if ((b and ($80 shr byte(r)))<>0) and is_reg_var[r] then - store_regvar(exprasmlist,r) - end; - - - procedure saveusedregisters(var saved : tsaved;b : byte); - - var - r : tregister; - hr : treference; - - begin - usedinproc:=usedinproc or b; - for r:=R_EAX to R_EBX do - begin - saved[r]:=reg_not_saved; - { if the register is used by the calling subroutine } - if ((b and ($80 shr byte(r)))<>0) then - begin - { and is present in use } - if not(r in unused) then - begin - { then save it } - gettempofsizereference(4,hr); - saved[r]:=hr.offset; - exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,r,newreference(hr))); - { here was a big problem !!!!!} - { you cannot do that for a register that is - globally assigned to a var - this also means that you must push it much more - often, but there must be a better way - maybe by putting the value back to the stack !! } - if not(is_reg_var[r]) then - begin - unused:=unused+[r]; -{$ifdef TEMPREGDEBUG} - inc(usablereg32); -{$endif TEMPREGDEBUG} - end; - end; - end; - end; -{$ifdef SUPPORT_MMX} - for r:=R_MM0 to R_MM6 do - begin - saved[r]:=reg_not_saved; - { if the mmx register is in use, save it } - if not(r in unused) then - begin - gettempofsizereference(8,hr); - exprasmList.concat(Taicpu.Op_reg_ref(A_MOVQ,S_NO,r,newreference(hr))); - if not(is_reg_var[r]) then - begin - unused:=unused+[r]; -{$ifdef TEMPREGDEBUG} - inc(usableregmmx); -{$endif TEMPREGDEBUG} - end; - saved[r]:=hr.offset; - end; - end; -{$endif SUPPORT_MMX} -{$ifdef TEMPREGDEBUG} - testregisters32; -{$endif TEMPREGDEBUG} - end; - - procedure popusedregisters(const pushed : tpushed); - - var - r : tregister; -{$ifdef SUPPORT_MMX} - hr : preference; -{$endif SUPPORT_MMX} - begin - { restore in reverse order: } -{$ifdef SUPPORT_MMX} - for r:=R_MM6 downto R_MM0 do - begin - if pushed[r] then - begin - new(hr); - reset_reference(hr^); - hr^.base:=R_ESP; - exprasmList.concat(Taicpu.Op_ref_reg( - A_MOVQ,S_NO,hr,r)); - exprasmList.concat(Taicpu.Op_const_reg( - A_ADD,S_L,8,R_ESP)); - unused:=unused-[r]; -{$ifdef TEMPREGDEBUG} - dec(usableregmmx); -{$endif TEMPREGDEBUG} - end; - end; -{$endif SUPPORT_MMX} - for r:=R_EBX downto R_EAX do - if pushed[r] then - begin - exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,r)); -{$ifdef TEMPREGDEBUG} - if not (r in unused) then - { internalerror(10) - in cg386cal we always restore regs - that appear as used - due to a unused tmep storage PM } - else - dec(usablereg32); -{$endif TEMPREGDEBUG} - unused:=unused-[r]; - end; -{$ifdef TEMPREGDEBUG} - testregisters32; -{$endif TEMPREGDEBUG} - end; - - procedure restoreusedregisters(const saved : tsaved); - var - r : tregister; - hr : treference; - - begin - { restore in reverse order: } -{$ifdef SUPPORT_MMX} - for r:=R_MM6 downto R_MM0 do - begin - if saved[r]<>reg_not_saved then - begin - reset_reference(hr); - hr.base:=frame_pointer; - hr.offset:=saved[r]; - exprasmList.concat(Taicpu.Op_ref_reg( - A_MOVQ,S_NO,newreference(hr),r)); - unused:=unused-[r]; -{$ifdef TEMPREGDEBUG} - dec(usableregmmx); -{$endif TEMPREGDEBUG} - ungetiftemp(hr); - end; - end; -{$endif SUPPORT_MMX} - for r:=R_EBX downto R_EAX do - if saved[r]<>reg_not_saved then - begin - reset_reference(hr); - hr.base:=frame_pointer; - hr.offset:=saved[r]; - exprasmList.concat(Taicpu.Op_ref_reg(A_MOV,S_L,newreference(hr),r)); -{$ifdef TEMPREGDEBUG} - if not (r in unused) then - internalerror(10) - else - dec(usablereg32); -{$endif TEMPREGDEBUG} - unused:=unused-[r]; - ungetiftemp(hr); - end; -{$ifdef TEMPREGDEBUG} - testregisters32; -{$endif TEMPREGDEBUG} - end; - - procedure ungetregister(r : tregister); - - begin - if r in [R_EAX,R_ECX,R_EDX,R_EBX,R_ESP,R_EBP,R_ESI,R_EDI] then - ungetregister32(r) - else if r in [R_AX,R_CX,R_DX,R_BX,R_SP,R_BP,R_SI,R_DI] then - ungetregister32(reg16toreg32(r)) - else if r in [R_AL,R_BL,R_CL,R_DL] then - ungetregister32(reg8toreg32(r)) -{$ifdef SUPPORT_MMX} - else if r in [R_MM0..R_MM6] then - ungetregistermmx(r) -{$endif SUPPORT_MMX} - else internalerror(18); - end; - - procedure ungetregister32(r : tregister); - - begin - if (r = R_EDI) or - ((not assigned(procinfo^._class)) and (r = R_ESI)) then - begin - exprasmList.concat(Tairegalloc.DeAlloc(r)); - exit; - end; - if cs_regalloc in aktglobalswitches then - begin - { takes much time } - if not(r in usableregs) then - exit; - unused:=unused+[r]; - inc(usablereg32); - end - else - begin - if not(r in [R_EAX,R_EBX,R_ECX,R_EDX]) then - exit; -{$ifdef TEMPREGDEBUG} - if (r in unused) then -{$ifdef EXTTEMPREGDEBUG} - begin - Comment(V_Debug,'register freed twice '+reg2str(r)); - testregisters32; - exit; - end -{$else EXTTEMPREGDEBUG} - exit -{$endif EXTTEMPREGDEBUG} - else -{$endif TEMPREGDEBUG} - inc(usablereg32); - unused:=unused+[r]; -{$ifdef TEMPREGDEBUG} - reg_releaser[r]:=curptree^; -{$endif TEMPREGDEBUG} - end; - exprasmList.concat(Tairegalloc.DeAlloc(r)); -{$ifdef TEMPREGDEBUG} - testregisters32; -{$endif TEMPREGDEBUG} - end; - -{$ifdef SUPPORT_MMX} - function getregistermmx : tregister; - - var - r : tregister; - - begin - dec(usableregmmx); - for r:=R_MM0 to R_MM6 do - if r in unused then - begin - unused:=unused-[r]; - usedinproc:=usedinproc or ($80 shr byte(R_EAX)); - getregistermmx:=r; - exit; - end; - internalerror(10); - end; - - procedure ungetregistermmx(r : tregister); - - begin - if cs_regalloc in aktglobalswitches then - begin - { takes much time } - if not(r in usableregs) then - exit; - unused:=unused+[r]; - inc(usableregmmx); - end - else - begin - unused:=unused+[r]; - inc(usableregmmx); - end; - end; -{$endif SUPPORT_MMX} - - function isaddressregister(reg: tregister): boolean; - - begin - isaddressregister := true; - end; - - procedure del_reference(const ref : treference); - - begin - if ref.is_immediate then - exit; - ungetregister32(ref.base); - ungetregister32(ref.index); - end; - - - procedure del_locref(const location : tlocation); - begin - if (location.loc<>loc_mem) and (location.loc<>loc_reference) then - exit; - if location.reference.is_immediate then - exit; - ungetregister32(location.reference.base); - ungetregister32(location.reference.index); - end; - - - procedure del_location(const l : tlocation); - begin - case l.loc of - LOC_REGISTER : - ungetregister(l.register); - LOC_MEM,LOC_REFERENCE : - del_reference(l.reference); - end; - end; - - -{$ifdef TEMPREGDEBUG} - procedure testregisters32; - var test : byte; - begin - test:=0; - if R_EAX in unused then - inc(test); - if R_EBX in unused then - inc(test); - if R_ECX in unused then - inc(test); - if R_EDX in unused then - inc(test); - if test<>usablereg32 then - internalerror(10); - end; -{$endif TEMPREGDEBUG} - - function getregisterint : tregister; - begin - if usablereg32=0 then - internalerror(10); -{$ifdef TEMPREGDEBUG} - if curptree^^.usableregs-usablereg32>curptree^^.registers32 then - internalerror(10); -{$endif TEMPREGDEBUG} -{$ifdef EXTTEMPREGDEBUG} - if curptree^^.usableregs-usablereg32>curptree^^.reallyusedregs then - curptree^^.reallyusedregs:=curptree^^.usableregs-usablereg32; -{$endif EXTTEMPREGDEBUG} - dec(usablereg32); - if R_EAX in unused then - begin - unused:=unused-[R_EAX]; - usedinproc:=usedinproc or ($80 shr byte(R_EAX)); - getregisterint:=R_EAX; -{$ifdef TEMPREGDEBUG} - reg_user[R_EAX]:=curptree^; -{$endif TEMPREGDEBUG} - exprasmList.concat(Tairegalloc.Alloc(R_EAX)); - end - else if R_EDX in unused then - begin - unused:=unused-[R_EDX]; - usedinproc:=usedinproc or ($80 shr byte(R_EDX)); - getregisterint:=R_EDX; -{$ifdef TEMPREGDEBUG} - reg_user[R_EDX]:=curptree^; -{$endif TEMPREGDEBUG} - exprasmList.concat(Tairegalloc.Alloc(R_EDX)); - end - else if R_EBX in unused then - begin - unused:=unused-[R_EBX]; - usedinproc:=usedinproc or ($80 shr byte(R_EBX)); - getregisterint:=R_EBX; -{$ifdef TEMPREGDEBUG} - reg_user[R_EBX]:=curptree^; -{$endif TEMPREGDEBUG} - exprasmList.concat(Tairegalloc.Alloc(R_EBX)); - end - else if R_ECX in unused then - begin - unused:=unused-[R_ECX]; - usedinproc:=usedinproc or ($80 shr byte(R_ECX)); - getregisterint:=R_ECX; -{$ifdef TEMPREGDEBUG} - reg_user[R_ECX]:=curptree^; -{$endif TEMPREGDEBUG} - exprasmList.concat(Tairegalloc.Alloc(R_ECX)); - end - else internalerror(10); -{$ifdef TEMPREGDEBUG} - testregisters32; -{$endif TEMPREGDEBUG} - end; - - - function getaddressregister: tregister; - - begin - getaddressregister := getregisterint; - end; - - function getexplicitregister32(r : tregister) : tregister; - - begin - if r in [R_ESI,R_EDI] then - begin - exprasmList.concat(Tairegalloc.Alloc(r)); - getexplicitregister32 := r; - exit; - end; - if r in unused then - begin - dec(usablereg32); -{$ifdef TEMPREGDEBUG} - if curptree^^.usableregs-usablereg32>curptree^^.registers32 then - internalerror(10); - reg_user[r]:=curptree^; -{$endif TEMPREGDEBUG} - unused:=unused-[r]; - usedinproc:=usedinproc or ($80 shr byte(r)); - exprasmList.concat(Tairegalloc.Alloc(r)); - getexplicitregister32:=r; -{$ifdef TEMPREGDEBUG} - testregisters32; -{$endif TEMPREGDEBUG} - end - else - getexplicitregister32:=getregisterint; - end; - - procedure cleartempgen; - - begin - unused:=usableregs; - usablereg32:=c_usableregs; - {fpuvaroffset:=0; - this must only be resetted at each procedure - compilation start PM } - end; - - - procedure clearregistercount; - var - regi : tregister; - begin -{$ifdef SUPPORT_MMX} - for regi:=R_EAX to R_MM6 do - begin - reg_pushes[regi]:=0; - is_reg_var[regi]:=false; - end; -{$else SUPPORT_MMX} - for regi:=R_EAX to R_EDI do - begin - reg_pushes[regi]:=0; - is_reg_var[regi]:=false; - end; -{$endif SUPPORT_MMX} - end; - - function correct_fpuregister(r : tregister;ofs : byte) : tregister; - - begin - correct_fpuregister:=tregister(longint(r)+ofs); - end; - - procedure resetusableregisters; - begin -{$ifdef SUPPORT_MMX} - usableregs:=[R_EAX,R_EBX,R_ECX,R_EDX,R_MM0..R_MM6]; - c_usableregs:=4; - usableregmmx:=8; -{$else} - usableregs:=[R_EAX,R_EBX,R_ECX,R_EDX]; - c_usableregs:=4; -{$endif SUPPORT_MMX} - fillchar(regvar_loaded,sizeof(regvar_loaded),false); - fillchar(is_reg_var,sizeof(is_reg_var),false); - fpuvaroffset:=0; - end; - -begin - resetusableregisters; -end. -{ - $Log$ - Revision 1.2 2002-09-07 15:25:15 peter - * old logs removed and tabs fixed - - Revision 1.1 2002/08/22 08:30:50 mazen - first insertion 2002\08\22 - -}