freepascal.compiler/compiler/tgen68k.pas

{
    $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).

}