freepascal.compiler/compiler/ncgbas.pas

{
    Copyright (c) 2000-2002 by Florian Klaempfl

    This unit implements some basic nodes

    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 ncgbas;

{$i fpcdefs.inc}

interface

    uses
       cpubase,cgutils,
       node,nbas;

    type
       tcgnothingnode = class(tnothingnode)
          procedure pass_2;override;
       end;

       tcgasmnode = class(tasmnode)
          procedure pass_2;override;
       end;

       tcgstatementnode = class(tstatementnode)
          procedure pass_2;override;
       end;

       tcgblocknode = class(tblocknode)
          procedure pass_2;override;
       end;

       tcgtempcreatenode = class(ttempcreatenode)
          procedure pass_2;override;
       end;

       tcgtemprefnode = class(ttemprefnode)
          procedure pass_2;override;
          { Changes the location of this temp to ref. Useful when assigning }
          { another temp to this one. The current location will be freed.   }
          { Can only be called in pass 2 (since earlier, the temp location  }
          { isn't known yet)                                                }
          procedure changelocation(const ref: treference);
       end;

       tcgtempdeletenode = class(ttempdeletenode)
          procedure pass_2;override;
       end;

  implementation

    uses
      globtype,systems,
      cutils,verbose,
      aasmbase,aasmtai,aasmcpu,symsym,symconst,
      defutil,
      nflw,pass_2,
      cgbase,cgobj,
      procinfo,
      tgobj
      ;

{*****************************************************************************
                                 TNOTHING
*****************************************************************************}

    procedure tcgnothingnode.pass_2;
      begin
         location_reset(location,LOC_VOID,OS_NO);

         { avoid an abstract rte }
      end;


{*****************************************************************************
                               TSTATEMENTNODE
*****************************************************************************}

    procedure tcgstatementnode.pass_2;
      var
         hp : tstatementnode;
      begin
         location_reset(location,LOC_VOID,OS_NO);

         hp:=self;
         while assigned(hp) do
          begin
            if assigned(hp.left) then
             begin
               secondpass(hp.left);
               { Compiler inserted blocks can return values }
               location_copy(hp.location,hp.left.location);
             end;
            hp:=tstatementnode(hp.right);
          end;
      end;


{*****************************************************************************
                               TASMNODE
*****************************************************************************}

    procedure tcgasmnode.pass_2;

      procedure ReLabel(var p:tasmsymbol);
        begin
          { Only relabel local tasmlabels }
          if (p.defbind = AB_LOCAL) and
             (p is tasmlabel) then
           begin
             if not assigned(p.altsymbol) then
               objectlibrary.GenerateAltSymbol(p);
             p:=p.altsymbol;
             p.increfs;
           end;
        end;

      procedure ResolveRef(var op:toper);
        var
          sym : tabstractnormalvarsym;
{$ifdef x86}
          scale : byte;
{$endif x86}
          forceref,
          getoffset : boolean;
          indexreg : tregister;
          sofs : longint;
        begin
          if (op.typ=top_local) then
            begin
              sofs:=op.localoper^.localsymofs;
              indexreg:=op.localoper^.localindexreg;
{$ifdef x86}
              scale:=op.localoper^.localscale;
{$endif x86}
              getoffset:=op.localoper^.localgetoffset;
              forceref:=op.localoper^.localforceref;
              sym:=tabstractnormalvarsym(pointer(op.localoper^.localsym));
              dispose(op.localoper);
              case sym.localloc.loc of
                LOC_REFERENCE :
                  begin
                    if getoffset then
                      begin
                        if indexreg=NR_NO then
                          begin
                            op.typ:=top_const;
                            op.val:=sym.localloc.reference.offset+sofs;
                          end
                        else
                          begin
                            op.typ:=top_ref;
                            new(op.ref);
                            reference_reset_base(op.ref^,indexreg,sym.localloc.reference.offset+sofs);
                          end;
                      end
                    else
                      begin
                        op.typ:=top_ref;
                        new(op.ref);
                        reference_reset_base(op.ref^,sym.localloc.reference.base,sym.localloc.reference.offset+sofs);
                        op.ref^.index:=indexreg;
{$ifdef x86}
                        op.ref^.scalefactor:=scale;
{$endif x86}
                      end;
                  end;
                LOC_REGISTER :
                  begin
                    if getoffset then
                      Message(asmr_e_invalid_reference_syntax);
                    { Subscribed access }
                    if forceref or
                       (sofs<>0) then
                      begin
                        op.typ:=top_ref;
                        new(op.ref);
                        reference_reset_base(op.ref^,sym.localloc.register,sofs);
                        op.ref^.index:=indexreg;
{$ifdef x86}
                        op.ref^.scalefactor:=scale;
{$endif x86}
                      end
                    else
                      begin
                        op.typ:=top_reg;
                        op.reg:=sym.localloc.register;
                      end;
                  end;
              end;
            end;
        end;

      var
        hp,hp2 : tai;
        i : longint;
        skipnode : boolean;
      begin
         location_reset(location,LOC_VOID,OS_NO);

         if (nf_get_asm_position in flags) then
           begin
             { Add a marker, to be sure the list is not empty }
             exprasmlist.concat(tai_marker.create(marker_position));
             currenttai:=tai(exprasmlist.last);
             exit;
           end;

         { Allocate registers used in the assembler block }
         cg.alloccpuregisters(exprasmlist,R_INTREGISTER,used_regs_int);

         if (po_inline in current_procinfo.procdef.procoptions) then
           begin
             objectlibrary.CreateUsedAsmSymbolList;
             hp:=tai(p_asm.first);
             while assigned(hp) do
              begin
                hp2:=tai(hp.getcopy);
                skipnode:=false;
                case hp2.typ of
                  ait_label :
                     ReLabel(tasmsymbol(tai_label(hp2).l));
                  ait_const_64bit,
                  ait_const_32bit,
                  ait_const_16bit,
                  ait_const_8bit,
                  ait_const_rva_symbol,
                  ait_const_indirect_symbol :
                     begin
                       if assigned(tai_const(hp2).sym) then
                         ReLabel(tai_const(hp2).sym);
                       if assigned(tai_const(hp2).endsym) then
                         ReLabel(tai_const(hp2).endsym);
                     end;
                  ait_instruction :
                     begin
                       { remove cached insentry, because the new code can
                         require an other less optimized instruction }
{$ifdef i386}
{$ifndef NOAG386BIN}
                       taicpu(hp2).ResetPass1;
{$endif}
{$endif}
                       { fixup the references }
                       for i:=1 to taicpu(hp2).ops do
                        begin
                          ResolveRef(taicpu(hp2).oper[i-1]^);
                          with taicpu(hp2).oper[i-1]^ do
                           begin
                             case typ of
                               top_ref :
                                 begin
                                   if assigned(ref^.symbol) then
                                     ReLabel(ref^.symbol);
                                   if assigned(ref^.relsymbol) then
                                     ReLabel(ref^.relsymbol);
                                 end;
                             end;
                           end;
                        end;
                     end;
                   ait_marker :
                     begin
                     { it's not an assembler block anymore }
                       if (tai_marker(hp2).kind in [AsmBlockStart, AsmBlockEnd]) then
                        skipnode:=true;
                     end;
                end;
                if not skipnode then
                  exprasmList.concat(hp2)
                else
                  hp2.free;
                hp:=tai(hp.next);
              end;
             { restore used symbols }
             objectlibrary.UsedAsmSymbolListResetAltSym;
             objectlibrary.DestroyUsedAsmSymbolList;
           end
         else
           begin
             hp:=tai(p_asm.first);
             while assigned(hp) do
              begin
                case hp.typ of
                  ait_instruction :
                     begin
                       { remove cached insentry, because the new code can
                         require an other less optimized instruction }
{$ifdef i386}
{$ifndef NOAG386BIN}
                       taicpu(hp).ResetPass1;
{$endif}
{$endif}
                       { fixup the references }
                       for i:=1 to taicpu(hp).ops do
                         ResolveRef(taicpu(hp).oper[i-1]^);
                     end;
                end;
                hp:=tai(hp.next);
              end;
             { insert the list }
             exprasmList.concatlist(p_asm);
           end;

         { Release register used in the assembler block }
         cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,used_regs_int);
       end;


{*****************************************************************************
                             TBLOCKNODE
*****************************************************************************}

    procedure tcgblocknode.pass_2;
      var
        hp : tstatementnode;
        oldexitlabel : tasmlabel;
      begin
        location_reset(location,LOC_VOID,OS_NO);

        { replace exitlabel? }
        if nf_block_with_exit in flags then
          begin
            oldexitlabel:=current_procinfo.aktexitlabel;
            objectlibrary.getlabel(current_procinfo.aktexitlabel);
          end;

        { do second pass on left node }
        if assigned(left) then
         begin
           hp:=tstatementnode(left);
           while assigned(hp) do
            begin
              if assigned(hp.left) then
               begin
                 secondpass(hp.left);
                 location_copy(hp.location,hp.left.location);
               end;
              location_copy(location,hp.location);
              hp:=tstatementnode(hp.right);
            end;
         end;

        { write exitlabel }
        if nf_block_with_exit in flags then
          begin
            cg.a_label(exprasmlist,current_procinfo.aktexitlabel);
            current_procinfo.aktexitlabel:=oldexitlabel;
          end;
      end;


{*****************************************************************************
                          TTEMPCREATENODE
*****************************************************************************}

    procedure tcgtempcreatenode.pass_2;
      begin
        location_reset(location,LOC_VOID,OS_NO);

        { if we're secondpassing the same tcgtempcreatenode twice, we have a bug }
        if tempinfo^.valid then
          internalerror(200108222);

        { get a (persistent) temp }
        if tempinfo^.restype.def.needs_inittable then
          begin
            location_reset(tempinfo^.location,LOC_REFERENCE,def_cgsize(tempinfo^.restype.def));
            tg.GetTempTyped(exprasmlist,tempinfo^.restype.def,tempinfo^.temptype,tempinfo^.location.reference);
          end
        else if tempinfo^.may_be_in_reg then
          begin
            if tempinfo^.restype.def.deftype=floatdef then
              begin
                if (tempinfo^.temptype = tt_persistent) then
                  location_reset(tempinfo^.location,LOC_CFPUREGISTER,def_cgsize(tempinfo^.restype.def))
                else
                  location_reset(tempinfo^.location,LOC_FPUREGISTER,def_cgsize(tempinfo^.restype.def));
                tempinfo^.location.register:=cg.getfpuregister(exprasmlist,tempinfo^.location.size);
              end
            else
              begin
                if (tempinfo^.temptype = tt_persistent) then
                  location_reset(tempinfo^.location,LOC_CREGISTER,def_cgsize(tempinfo^.restype.def))
                else
                  location_reset(tempinfo^.location,LOC_REGISTER,def_cgsize(tempinfo^.restype.def));
{$ifndef cpu64bit}
                if tempinfo^.location.size in [OS_64,OS_S64] then
                  begin
                    tempinfo^.location.register64.reglo:=cg.getintregister(exprasmlist,OS_32);
                    tempinfo^.location.register64.reghi:=cg.getintregister(exprasmlist,OS_32);
                  end
                else
{$endif cpu64bit}
                  tempinfo^.location.register:=cg.getintregister(exprasmlist,tempinfo^.location.size);
              end;
          end
        else
          begin
            location_reset(tempinfo^.location,LOC_REFERENCE,def_cgsize(tempinfo^.restype.def));
            tg.GetTemp(exprasmlist,size,tempinfo^.temptype,tempinfo^.location.reference);
          end;
        tempinfo^.valid := true;
      end;


{*****************************************************************************
                             TTEMPREFNODE
*****************************************************************************}

    procedure tcgtemprefnode.pass_2;
      begin
        { check if the temp is valid }
        if not tempinfo^.valid then
          internalerror(200108231);
        location:=tempinfo^.location;
        if tempinfo^.location.loc=LOC_REFERENCE then
          inc(location.reference.offset,offset);
      end;


    procedure tcgtemprefnode.changelocation(const ref: treference);
      begin
        { check if the temp is valid }
        if not tempinfo^.valid then
          internalerror(200306081);
        if (tempinfo^.location.loc<>LOC_REFERENCE) then
          internalerror(2004020203);
        if (tempinfo^.temptype = tt_persistent) then
          tg.ChangeTempType(exprasmlist,tempinfo^.location.reference,tt_normal);
        tg.ungettemp(exprasmlist,tempinfo^.location.reference);
        tempinfo^.location.reference := ref;
        tg.ChangeTempType(exprasmlist,tempinfo^.location.reference,tempinfo^.temptype);
        { adapt location }
        location.reference := ref;
        inc(location.reference.offset,offset);
      end;


{*****************************************************************************
                           TTEMPDELETENODE
*****************************************************************************}

    procedure tcgtempdeletenode.pass_2;
      begin
        location_reset(location,LOC_VOID,OS_NO);

        case tempinfo^.location.loc of
          LOC_REFERENCE:
            begin
              if release_to_normal then
                tg.ChangeTempType(exprasmlist,tempinfo^.location.reference,tt_normal)
              else
                tg.UnGetTemp(exprasmlist,tempinfo^.location.reference);
            end;
          LOC_CREGISTER,
          LOC_REGISTER:
            begin
              { make sure the register allocator doesn't reuse the }
              { register e.g. in the middle of a loop              }
{$ifndef cpu64bit}
              if tempinfo^.location.size in [OS_64,OS_S64] then
                begin
                  cg.a_reg_sync(exprasmlist,tempinfo^.location.register64.reghi);
                  cg.a_reg_sync(exprasmlist,tempinfo^.location.register64.reglo);
                end
              else
{$endif cpu64bit}
                cg.a_reg_sync(exprasmlist,tempinfo^.location.register);
              if release_to_normal then
                tempinfo^.location.loc := LOC_REGISTER;
            end;
          LOC_CFPUREGISTER,
          LOC_FPUREGISTER:
            begin
              { make sure the register allocator doesn't reuse the }
              { register e.g. in the middle of a loop              }
              cg.a_reg_sync(exprasmlist,tempinfo^.location.register);
              if release_to_normal then
                tempinfo^.location.loc := LOC_FPUREGISTER;
            end;
          else
            internalerror(200507161);
        end;
      end;


begin
   cnothingnode:=tcgnothingnode;
   casmnode:=tcgasmnode;
   cstatementnode:=tcgstatementnode;
   cblocknode:=tcgblocknode;
   ctempcreatenode:=tcgtempcreatenode;
   ctemprefnode:=tcgtemprefnode;
   ctempdeletenode:=tcgtempdeletenode;
end.