paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-02 11:56:41 +02:00
Code Issues Packages Projects Releases Wiki Activity
85c8a88cbe
fpc/compiler/tgen68k.pas
pierre 0e8616ed1f + temporary variables now in temp_gen.pas unit 
because it is processor independent
  * mppc68k.bat modified to undefine i386 and support_mmx
    (which are defaults for i386)
1998-06-08 13:13:28 +00:00

384 lines
12 KiB
ObjectPascal
Raw Blame History

{
$Id$
Copyright (c) 1993-98 by Florian Klaempfl, Carl Eric Codere
This unit handles the temporary variables stuff for m68k
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 tgen68k;
interface
uses
cobjects,globals,tree,hcodegen,verbose,files,aasm
{$ifdef m68k}
,m68k
{$endif}
;
type
tregisterset = set of tregister;
tpushed = array[R_D0..R_A6] of boolean;
const
{ D2 to D5 usable as scratch registers }
usablereg32 : byte = 4;
{ A2 to A4 usable as address registers }
usableaddress: byte = 3;
{ FP2 to FP7 usable as FPU registers }
usablefloatreg : byte = 6;
function getregister32 : tregister;
procedure ungetregister32(r : tregister);
{ return a free 32-bit address register }
function getaddressreg: tregister;
procedure ungetregister(r : tregister);
procedure cleartempgen;
function getfloatreg: tregister;
{ returns a free floating point register }
{ used in real, fpu mode, otherwise we }
{ must use standard register allocation }
procedure del_reference(const ref : treference);
procedure del_locref(const location : tlocation);
{ pushs and restores registers }
procedure pushusedregisters(var pushed : tpushed;b : word);
procedure popusedregisters(const pushed : tpushed);
var
unused,usableregs : tregisterset;
c_usableregs : longint;
usedinproc : word;
{ count, how much a register must be pushed if it is used as register }
{ variable }
reg_pushes : array[R_D0..R_A6] of longint;
is_reg_var : array[R_D0..R_A6] of boolean;
implementation
procedure pushusedregisters(var pushed : tpushed;b : word);
var
r : tregister;
begin
{ the following registers can be pushed }
{ D0, D1, D2, D3, D4, D5, D6, D7, A0 }
{ A1, A2, A3, A4 }
for r:=R_D2 to R_A4 do
begin
pushed[r]:=false;
{ if the register is used by the calling subroutine }
if ((b and ($800 shr word(r)))<>0) then
begin
{ and is present in use }
if not(r in unused) then
begin
{ then save it }
{ then save it on the stack }
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,r,R_SPPUSH)));
{ 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
unused:=unused+[r];
pushed[r]:=true;
end;
end;
end;
end;
procedure popusedregisters(const pushed : tpushed);
var
r : tregister;
begin
for r:=R_A4 downto R_D2 do
if pushed[r] then
begin
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_SPPULL,r)));
unused:=unused-[r];
end;
end;
procedure ungetregister(r : tregister);
begin
ungetregister32(r)
end;
procedure del_reference(const ref : treference);
begin
if ref.isintvalue then
exit;
ungetregister(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.isintvalue then
exit;
ungetregister(location.reference.base);
ungetregister32(location.reference.index);
end;
procedure ungetregister32(r : tregister);
begin
if r in [R_D2,R_D3,R_D4,R_D5,R_D7] then
begin
unused:=unused+[r];
inc(usablereg32);
end
else
if r in [R_FP2,R_FP3,R_FP4,R_FP5,R_FP6,R_FP7] then
begin
unused:=unused+[r];
inc(usablefloatreg);
end
else
if r in [R_A2,R_A3,R_A4,R_A6,R_SP] then
begin
unused:=unused+[r];
inc(usableaddress);
{$ifdef EXTDEBUG}
end
else
begin
if not (r in [R_NO]) then
begin
Comment(V_Debug,'ungetregister32() deallocation of reserved register.');
end;
end;
{$ELSE}
end;
{$ENDIF}
end;
function getfloatreg: tregister;
{ returns a free floating point register }
{ used in real, fpu mode, otherwise we }
{ must use standard register allocation }
var
i:tregister;
begin
dec(usablefloatreg);
if usablefloatreg = 0 then
Message(cg_f_internal_error_in_getfloatreg);
for i:=R_FP2 to R_FP7 do
begin
if i in unused then
begin
unused := unused-[i];
getfloatreg := i;
exit;
end;
end;
{ if we are here, then there was an allocation failure }
Message(cg_f_internal_error_in_getfloatreg);
end;
function getaddressreg: tregister;
begin
dec(usableaddress);
if R_A2 in unused then
begin
unused:=unused-[R_A2];
usedinproc:=usedinproc or ($800 shr word(R_A2));
getaddressreg:=R_A2;
end
else
if R_A3 in unused then
begin
unused:=unused-[R_A3];
usedinproc:=usedinproc or ($800 shr word(R_A3));
getaddressreg:=R_A3;
end
else
if R_A4 in unused then
begin
unused:=unused-[R_A4];
usedinproc:=usedinproc or ($800 shr word(R_A4));
getaddressreg:=R_A4;
end
else
begin
internalerror(10);
end;
end;
function getregister32 : tregister;
begin
dec(usablereg32);
if R_D2 in unused then
begin
unused:=unused-[R_D2];
usedinproc:=usedinproc or ($800 shr word(R_D2));
getregister32:=R_D2;
end
else if R_D3 in unused then
begin
unused:=unused-[R_D3];
usedinproc:=usedinproc or ($800 shr word(R_D3));
getregister32:=R_D3;
end
else if R_D4 in unused then
begin
unused:=unused-[R_D4];
usedinproc:=usedinproc or ($800 shr word(R_D4));
getregister32:=R_D4;
end
else if R_D5 in unused then
begin
unused:=unused-[R_D5];
usedinproc:=usedinproc or ($800 shr word(R_D5));
getregister32:=R_D5;
end
else if R_D7 in unused then
begin
unused:=unused-[R_D7];
usedinproc:=usedinproc or ($800 shr word(R_D7));
getregister32:=R_D7;
end
else
begin
internalerror(10);
end;
end;
procedure cleartempgen;
begin
unused:=usableregs;
usablereg32:=c_usableregs;
end;
begin
{ contains both information on Address registers and data registers }
{ even if they are allocated separately. }
usableregs:=[R_D0,R_D1,R_D2,R_D3,R_D4,R_D5,R_D6,R_D7,R_A0,R_A1,R_A2,R_A3,R_A4,
R_FP0,R_FP1,R_FP2,R_FP3,R_FP4,R_FP5,R_FP6,R_FP7];
c_usableregs:=4;
end.
{
$Log$
Revision 1.2 1998-06-08 13:13:46 pierre
+ temporary variables now in temp_gen.pas unit
because it is processor independent
* mppc68k.bat modified to undefine i386 and support_mmx
(which are defaults for i386)
Revision 1.1.1.1 1998/03/25 11:18:15 root
* Restored version
Revision 1.12 1998/03/22 12:45:38 florian
* changes of Carl-Eric to m68k target commit:
- wrong nodes because of the new string cg in intel, I had to create
this under m68k also ... had to work it out to fix potential alignment
problems --> this removes the crash of the m68k compiler.
- added absolute addressing in m68k assembler (required for Amiga startup)
- fixed alignment problems (because of byte return values, alignment
would not be always valid) -- is this ok if i change the offset if odd in
setfirsttemp ?? -- it seems ok...
Revision 1.11 1998/03/10 04:21:15 carl
* fixed extdebug problems
Revision 1.10 1998/03/10 01:17:30 peter
* all files have the same header
* messages are fully implemented, EXTDEBUG uses Comment()
+ AG... files for the Assembler generation
Revision 1.9 1998/03/06 00:53:00 peter
* replaced all old messages from errore.msg, only ExtDebug and some
Comment() calls are left
* fixed options.pas
Revision 1.8 1998/03/02 01:49:35 peter
* renamed target_DOS to target_GO32V1
+ new verbose system, merged old errors and verbose units into one new
verbose.pas, so errors.pas is obsolete
Revision 1.7 1998/02/13 10:35:51 daniel
* Made Motorola version compilable.
* Fixed optimizer
Revision 1.6 1998/01/11 03:40:16 carl
+ added fpu register allocation
Revision 1.3 1997/12/09 14:13:07 carl
* bugfix of free register list.
Revision 1.2 1997/11/28 18:14:49 pierre
working version with several bug fixes
Revision 1.1.1.1 1997/11/27 08:33:03 michael
FPC Compiler CVS start
Pre-CVS log:
+ feature added
- removed
* bug fixed or changed
History (started with version 0.9.0):
7th december 1996:
* some code from Pierre Muller inserted
makes the use of the stack more efficient
5th september 1997:
+ Converted for Motorola MC68000 output (C. E. Codere)
24nd september 1997:
+ Reserved register list modified. (CEC)
26 september 1997:
+ Converted to work with v093 (CEC)
* Knowing that base is in address register, modified routines
accordingly. (CEC)
27 september 1997:
+ pushusedregisters now pushes only non-scratch registers.
2nd october 1997:
+ added strict error checking when extdebug defined.
23 october 1997:
- it seems that sp, and the base pointer can be freed in ungetregister,
removed warning accordingly. (CEC).
* bugfix of address register in usableregs set. (They were not defined...) (CEC).
* other stupid bug! When I changed the register conventions, I forgot to change
getaddressreg to reflect those changes!! (CEC).
}
Reference in New Issue View Git Blame Copy Permalink