fpc/compiler/aasmbase.pas

{
    Copyright (c) 1998-2002 by Florian Klaempfl

    This unit implements an abstract asmoutput class for all processor types

    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.

 ****************************************************************************
}
{ @abstract(This unit implements an abstract asm output class for all processor types)
  This unit implements an abstract assembler output class for all processors, these
  are then overriden for each assembler writer to actually write the data in these
  classes to an assembler file.
}

unit aasmbase;

{$i fpcdefs.inc}

interface

    uses
       cutils,cclasses,
       globtype,globals,systems
       ;

    type
       TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL);

       TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL);

       { is the label only there for getting an DataOffset (e.g. for i/o
         checks -> alt_addr) or is it a jump target (alt_jump), for debug
         info alt_dbgline and alt_dbgfile, etc. }
       TAsmLabelType = (alt_jump,alt_addr,alt_data,alt_dbgline,alt_dbgfile,alt_dbgtype,alt_dbgframe);

    const
       asmlabeltypeprefix : array[TAsmLabeltype] of char = ('j','a','d','l','f','t','c');

    type
       TAsmSectiontype=(sec_none,
         sec_code,
         sec_data,
         sec_rodata,
         sec_bss,
         sec_threadvar,
         { used for wince exception handling }
         sec_pdata,
         { used for darwin import stubs }
         sec_stub,
         { stabs }
         sec_stab,sec_stabstr,
         { win32 }
         sec_idata2,sec_idata4,sec_idata5,sec_idata6,sec_idata7,sec_edata,
         { C++ exception handling unwinding (uses dwarf) }
         sec_eh_frame,
         { dwarf }
         sec_debug_frame,
         sec_debug_info,
         sec_debug_line,
         sec_debug_abbrev,
         { ELF resources }
         sec_fpc,
         { Table of contents section }
         sec_toc
       );

       TAsmSectionOrder = (secorder_begin,secorder_default,secorder_end);

       TAsmSymbol = class(TFPHashObject)
       private
         { this need to be incremented with every symbol loading into the
           TAsmList with loadsym/loadref/const_symbol (PFV) }
         refs       : longint;
       public
         bind       : TAsmsymbind;
         typ        : TAsmsymtype;
         { Alternate symbol which can be used for 'renaming' needed for
           asm inlining. Also used for external and common solving during linking }
         altsymbol  : TAsmSymbol;
         { Cached objsymbol }
         cachedobjsymbol : TObject;
         constructor Create(AList:TFPHashObjectList;const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
         function getaltcopy(AList:TFPHashObjectList;altnr: longint): TAsmSymbol; virtual;
         function  is_used:boolean;
         procedure increfs;
         procedure decrefs;
         function getrefs: longint;
       end;
       TAsmSymbolClass = class of TAsmSymbol;

       TAsmLabel = class(TAsmSymbol)
       protected
         function getname:string;override;
       public
         labelnr   : longint;
         labeltype : TAsmLabelType;
         is_set    : boolean;
         constructor Createlocal(AList:TFPHashObjectList;nr:longint;ltyp:TAsmLabelType);
         constructor Createglobal(AList:TFPHashObjectList;const modulename:string;nr:longint;ltyp:TAsmLabelType);
         function getaltcopy(AList:TFPHashObjectList;altnr: longint): TAsmSymbol; override;
       end;

    function  use_smartlink_section:boolean;
    function  maybe_smartlink_symbol:boolean;

    function LengthUleb128(a: qword) : byte;
    function LengthSleb128(a: int64) : byte;
    function EncodeUleb128(a: qword;out buf) : byte;
    function EncodeSleb128(a: int64;out buf) : byte;


implementation

    uses
      SysUtils,
      verbose;


    function use_smartlink_section:boolean;
      begin
        result:=(af_smartlink_sections in target_asm.flags) and
                (tf_smartlink_sections in target_info.flags);
      end;


    function maybe_smartlink_symbol:boolean;
      begin
        result:=(cs_Create_smart in current_settings.moduleswitches) or
                use_smartlink_section;
      end;


    function LengthUleb128(a: qword) : byte;
      begin
        result:=0;
        repeat
          a := a shr 7;
          inc(result);
          if a=0 then
            break;
        until false;
      end;


    function LengthSleb128(a: int64) : byte;
      var
        b, size: byte;
        asign : int64;
        neg, more: boolean;
      begin
        more := true;
        neg := a < 0;
        size := sizeof(a)*8;
        result:=0;
        repeat
          b := a and $7f;
          a := a shr 7;
          if neg then
            begin
              { Use a variable to be sure that the correct or mask is generated }
              asign:=1;
              asign:=asign shl (size - 7);
              a := a or -asign;
            end;
          if (((a = 0) and
               (b and $40 = 0)) or
              ((a = -1) and
               (b and $40 <> 0))) then
            more := false;
          inc(result);
          if not(more) then
            break;
        until false;
      end;


    function EncodeUleb128(a: qword;out buf) : byte;
      var
        b: byte;
        pbuf : pbyte;
      begin
        result:=0;
        pbuf:=@buf;
        repeat
          b := a and $7f;
          a := a shr 7;
          if a<>0 then
            b := b or $80;
          pbuf^:=b;
          inc(pbuf);
          inc(result);
          if a=0 then
            break;
        until false;
      end;


    function EncodeSleb128(a: int64;out buf) : byte;
      var
        b, size: byte;
        asign : int64;
        neg, more: boolean;
        pbuf : pbyte;
      begin
        more := true;
        neg := a < 0;
        size := sizeof(a)*8;
        result:=0;
        pbuf:=@buf;
        repeat
          b := a and $7f;
          a := a shr 7;
          if neg then
            begin
              { Use a variable to be sure that the correct or mask is generated }
              asign:=1;
              asign:=asign shl (size - 7);
              a := a or -asign;
            end;
          if (((a = 0) and
               (b and $40 = 0)) or
              ((a = -1) and
               (b and $40 <> 0))) then
            more := false
          else
            b := b or $80;
          pbuf^:=b;
          inc(pbuf);
          inc(result);
          if not(more) then
            break;
        until false;
      end;


{*****************************************************************************
                                 TAsmSymbol
*****************************************************************************}

    constructor TAsmSymbol.Create(AList:TFPHashObjectList;const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
      begin;
        inherited Create(AList,s);
        bind:=_bind;
        typ:=_typ;
        { used to remove unused labels from the al_procedures }
        refs:=0;
      end;


    function TAsmSymbol.getaltcopy(AList:TFPHashObjectList;altnr: longint): TAsmSymbol;
      begin
        result := TAsmSymbol(TAsmSymbolClass(classtype).Create(AList,name+'_'+tostr(altnr),bind,typ));
      end;


    function TAsmSymbol.is_used:boolean;
      begin
        is_used:=(refs>0);
      end;


    procedure TAsmSymbol.increfs;
      begin
        inc(refs);
      end;


    procedure TAsmSymbol.decrefs;
      begin
        dec(refs);
        if refs<0 then
          internalerror(200211121);
      end;


    function TAsmSymbol.getrefs: longint;
      begin
        getrefs := refs;
      end;


{*****************************************************************************
                                 TAsmLabel
*****************************************************************************}

    constructor TAsmLabel.Createlocal(AList:TFPHashObjectList;nr:longint;ltyp:TAsmLabelType);
      begin
        inherited Create(AList,target_asm.labelprefix+asmlabeltypeprefix[ltyp]+tostr(nr),AB_LOCAL,AT_LABEL);
        labelnr:=nr;
        labeltype:=ltyp;
        is_set:=false;
      end;


    constructor TAsmLabel.Createglobal(AList:TFPHashObjectList;const modulename:string;nr:longint;ltyp:TAsmLabelType);
      begin
        inherited Create(AList,'_$'+modulename+'$_L'+asmlabeltypeprefix[ltyp]+tostr(nr),AB_GLOBAL,AT_DATA);
        labelnr:=nr;
        labeltype:=ltyp;
        is_set:=false;
        { write it always }
        increfs;
      end;


    function TAsmLabel.getaltcopy(AList:TFPHashObjectList;altnr: longint): TAsmSymbol;
      begin;
        result := inherited getaltcopy(AList,altnr);
        TAsmLabel(result).labelnr:=labelnr;
        TAsmLabel(result).labeltype:=labeltype;
        TAsmLabel(result).is_set:=false;
        case bind of
          AB_GLOBAL:
            result.increfs;
          AB_LOCAL:
            ;
          else
            internalerror(2006053101);
        end;
      end;


    function TAsmLabel.getname:string;
      begin
        getname:=inherited getname;
        increfs;
      end;

end.