fpc/compiler/parabase.pas

{
    $Id$
    Copyright (c) 2002 by Florian Klaempfl

    Generic calling convention handling

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

{$i fpcdefs.inc}

  interface

    uses
       cclasses,globtype,
       cpubase,cgbase,cgutils;

    type
       TCGParaReference = record
          index       : tregister;
          offset      : aint;
       end;

       PCGParaLocation = ^TCGParaLocation;
       TCGParaLocation = record
         Next : PCGParaLocation;
         Size : TCGSize; { size of this location }
         Loc  : TCGLoc;
         case TCGLoc of
           LOC_REFERENCE : (reference : TCGParaReference);
           LOC_FPUREGISTER,
           LOC_CFPUREGISTER,
           LOC_MMREGISTER,
           LOC_CMMREGISTER,
           LOC_REGISTER,
           LOC_CREGISTER : (register : tregister);
       end;

       TCGPara = object
          Location  : PCGParalocation;
          Alignment : ShortInt;
          Size      : TCGSize;  { Size of the parameter included in all locations }
          IntSize: aint; { size of the total location in bytes }
{$ifdef powerpc}
          composite: boolean; { under the AIX abi, how certain parameters are passed depends on whether they are composite or not }
{$endif powerpc}
          constructor init;
          destructor  done;
          procedure   reset;
          function    getcopy:tcgpara;
          procedure   check_simple_location;
          function    is_single_reference(l: pcgparalocation): boolean;
          function    add_location:pcgparalocation;
          procedure   get_location(var newloc:tlocation);
       end;

       tvarargsinfo = (
         va_uses_float_reg
       );

       tparalist = class(tlist)
          procedure SortParas;
       end;

       tvarargsparalist = class(tparalist)
          varargsinfo : set of tvarargsinfo;
{$ifdef x86_64}
          { x86_64 requires %al to contain the no. SSE regs passed }
          mmregsused  : longint;
{$endif x86_64}
       end;



implementation

    uses
      systems,verbose,
      symsym;


{****************************************************************************
                                TCGPara
****************************************************************************}

    constructor tcgpara.init;
      begin
        alignment:=0;
        size:=OS_NO;
        intsize:=0;
        location:=nil;
{$ifdef powerpc}
        composite:=false;
{$endif powerpc}
      end;


    destructor tcgpara.done;
      begin
        reset;
      end;


    procedure tcgpara.reset;
      var
        hlocation : pcgparalocation;
      begin
        while assigned(location) do
          begin
            hlocation:=location^.next;
            dispose(location);
            location:=hlocation;
          end;
        alignment:=0;
        size:=OS_NO;
        intsize:=0;
{$ifdef powerpc}
        composite:=false;
{$endif powerpc}
      end;


    function tcgpara.getcopy:tcgpara;
      var
        hlocation : pcgparalocation;
      begin
        result.init;
        while assigned(location) do
          begin
            hlocation:=result.add_location;
            hlocation^:=location^;
            hlocation^.next:=nil;
            location:=location^.next;
          end;
        result.alignment:=alignment;
        result.size:=size;
        result.intsize:=intsize;
{$ifdef powerpc}
        result.composite:=composite;
{$endif powerpc}
      end;


    function tcgpara.add_location:pcgparalocation;
      var
        prevlocation,
        hlocation : pcgparalocation;
      begin
        prevlocation:=nil;
        hlocation:=location;
        while assigned(hlocation) do
          begin
            prevlocation:=hlocation;
            hlocation:=hlocation^.next;
          end;
        new(hlocation);
        Fillchar(hlocation^,sizeof(tcgparalocation),0);
        if assigned(prevlocation) then
          prevlocation^.next:=hlocation
        else
          location:=hlocation;
        result:=hlocation;
      end;


    function tcgpara.is_single_reference(l: pcgparalocation): boolean;
      begin
        result :=
          (l^.loc = LOC_REFERENCE) and
          not assigned(l^.next);
      end;


    procedure tcgpara.check_simple_location;
      begin
        if not assigned(location) then
          internalerror(200408161);
        if assigned(location^.next) then
          internalerror(200408162);
      end;


    procedure tcgpara.get_location(var newloc:tlocation);
      begin
        if not assigned(location) then
          internalerror(200408205);
        fillchar(newloc,sizeof(newloc),0);
        newloc.loc:=location^.loc;
        newloc.size:=size;
        case location^.loc of
          LOC_REGISTER :
            begin
{$ifndef cpu64bit}
              if size in [OS_64,OS_S64] then
                begin
                  if not assigned(location^.next) then
                    internalerror(200408206);
                  if (location^.next^.loc<>LOC_REGISTER) then
                    internalerror(200408207);
                  if (target_info.endian = ENDIAN_BIG) then
                    begin
                      newloc.register64.reghi:=location^.register;
                      newloc.register64.reglo:=location^.next^.register;
                    end
                  else
                    begin
                      newloc.register64.reglo:=location^.register;
                      newloc.register64.reghi:=location^.next^.register;
                    end;
                end
              else
{$endif}
                newloc.register:=location^.register;
            end;
          LOC_FPUREGISTER,
          LOC_MMREGISTER :
            newloc.register:=location^.register;
          LOC_REFERENCE :
            begin
              newloc.reference.base:=location^.reference.index;
              newloc.reference.offset:=location^.reference.offset;
            end;
        end;
      end;


{****************************************************************************
                          TParaList
****************************************************************************}

    function ParaNrCompare(Item1, Item2: Pointer): Integer;
      var
        I1 : tparavarsym absolute Item1;
        I2 : tparavarsym absolute Item2;
      begin
        Result:=I1.paranr-I2.paranr;
      end;


    procedure TParaList.SortParas;
      begin
        Sort(@ParaNrCompare);
      end;


end.

{
   $Log$
   Revision 1.10  2005-01-30 21:51:57  jonas
     * fixed darwin cycle

   Revision 1.9  2005/01/18 22:19:20  peter
     * multiple location support for i386 a_param_ref
     * remove a_param_copy_ref for i386

   Revision 1.8  2005/01/10 21:50:05  jonas
     + support for passing records in registers under darwin
     * tcgpara now also has an intsize field, which contains the size in
       bytes of the whole parameter

   Revision 1.7  2005/01/07 16:22:54  florian
     + implemented abi compliant handling of strucutured functions results on sparc platform

   Revision 1.6  2004/11/22 22:01:19  peter
     * fixed varargs
     * replaced dynarray with tlist

   Revision 1.5  2004/11/15 23:35:31  peter
     * tparaitem removed, use tparavarsym instead
     * parameter order is now calculated from paranr value in tparavarsym

   Revision 1.4  2004/10/31 21:45:03  peter
     * generic tlocation
     * move tlocation to cgutils

   Revision 1.3  2004/10/10 20:22:53  peter
     * symtable allocation rewritten
     * loading of parameters to local temps/regs cleanup
     * regvar support for parameters
     * regvar support for staticsymtable (main body)

   Revision 1.2  2004/09/21 17:25:12  peter
     * paraloc branch merged

   Revision 1.1.2.2  2004/09/14 19:09:37  jonas
     * fixed typo in IE check

   Revision 1.1.2.1  2004/09/02 15:47:58  peter
     * missing file

}