freepascal.compiler/compiler/loongarch64/cpupara.pas

{
    Copyright (c) 2002 by Florian Klaempfl

    LoongArch64 specific calling conventions

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

{$I fpcdefs.inc}

  interface

    uses
      globtype,
      aasmtai,aasmdata,
      cpubase,
      symconst, symtype, symdef, symsym,
      paramgr, parabase, cgbase, cgutils;

    type
      tcpuparamanager = class(tparamanager)
        function get_volatile_registers_int(calloption: tproccalloption): tcpuregisterset; override;
        function get_volatile_registers_fpu(calloption: tproccalloption): tcpuregisterset; override;
        function push_addr_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean; override;
        function ret_in_param(def: tdef; pd: tabstractprocdef): boolean; override;

        procedure getcgtempparaloc(list: TAsmList; pd : tabstractprocdef; nr: longint; var cgpara: tcgpara); override;
        function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint; override;
        function create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee; varargspara: tvarargsparalist): longint; override;
        function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;

      private
        procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
        function create_paraloc_info_intern(p: tabstractprocdef; side: tcallercallee; paras: tparalist; var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; isVararg : boolean): longint;
        function parseparaloc(p: tparavarsym; const s: string): boolean; override;
        procedure create_paraloc_for_def(var para: TCGPara; varspez: tvarspez; paradef: tdef; var nextfloatreg, nextintreg: tsuperregister; var stack_offset: aword; const isVararg, forceintmem: boolean; const side: tcallercallee; const p: tabstractprocdef);
      end;

implementation

    uses
      verbose, systems,
      globals, cpuinfo,
      defutil,symtable,symcpu,
      procinfo, cpupi;

    function tcpuparamanager.get_volatile_registers_int(calloption: tproccalloption): tcpuregisterset;
      begin
        result:=[RS_R0..RS_R31]-[RS_R3,RS_R22..RS_R31];
      end;

    function tcpuparamanager.get_volatile_registers_fpu(calloption: tproccalloption): tcpuregisterset;
      begin
        result:=[RS_F0..RS_F31]-[RS_F24..RS_F31];
      end;

    procedure tcpuparamanager.getcgtempparaloc(list: TAsmList; pd : tabstractprocdef; nr: longint; var cgpara: tcgpara);
      var
        paraloc: pcgparalocation;
        psym: tparavarsym;
        pdef: tdef;
      begin
        psym:=tparavarsym(pd.paras[nr-1]);
        pdef:=psym.vardef;
        if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
          pdef:=cpointerdef.getreusable_no_free(pdef);
        cgpara.reset;
        cgpara.size := def_cgsize(pdef);
        cgpara.intsize := tcgsize2size[cgpara.size];
        cgpara.alignment := get_para_align(pd.proccalloption);
        cgpara.def:=pdef;
        paraloc := cgpara.add_location;
        with paraloc^ do
          begin
            size := def_cgsize(pdef);
            def := pdef;
            if (nr <= 8) then
              begin
                if (nr = 0) then
                  internalerror(2022111916);
                loc := LOC_REGISTER;
                register := newreg(R_INTREGISTER, RS_R4 + nr-1, R_SUBWHOLE);
              end
            else
              begin
                loc := LOC_REFERENCE;
                paraloc^.reference.index := NR_STACK_POINTER_REG;
                reference.offset := sizeof(aint) * (nr - 9);
              end;
          end;
      end;

    function getparaloc(p: tdef): tcgloc;
      var
        hfabasedef: tdef;
      begin
        { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
          if push_addr_param for the def is true
        }
        case p.typ of
          orddef:
            result := LOC_REGISTER;
          floatdef:
            result := LOC_FPUREGISTER;
          enumdef:
            result := LOC_REGISTER;
          pointerdef:
            result := LOC_REGISTER;
          formaldef:
            result := LOC_REGISTER;
          classrefdef:
            result := LOC_REGISTER;
          procvardef:
            result := LOC_REGISTER;
          recorddef:
            result := LOC_REGISTER;
            { result := LOC_FPUREGISTER; }
          objectdef:
            if is_object(p) then
              result := LOC_REFERENCE
            else
              result := LOC_REGISTER;
          stringdef:
            if is_shortstring(p) or is_longstring(p) then
              result := LOC_REFERENCE
            else
              result := LOC_REGISTER;
          filedef:
            result := LOC_REGISTER;
          arraydef:
            if is_dynamic_array(p) then
              getparaloc:=LOC_REGISTER
            else
              result := LOC_REFERENCE;
          setdef:
            if is_smallset(p) then
              result := LOC_REGISTER
            else
              result := LOC_REFERENCE;
          variantdef:
            result := LOC_REFERENCE;
          { avoid problems with errornous definitions }
          errordef:
            result := LOC_REGISTER;
        else
          internalerror(2022111917);
        end;
      end;

    function tcpuparamanager.push_addr_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
      begin
        result := false;
        { var,out,constref always require address }
        if varspez in [vs_var, vs_out, vs_constref] then
        begin
          result := true;
          exit;
        end;
        case def.typ of
          variantdef,
          formaldef:
            result := true;
          procvardef,
          recorddef:
            result := (def.size > 16);
          arraydef:
            result := (tarraydef(def).highrange >= tarraydef(def).lowrange) or
              is_open_array(def) or
              is_array_of_const(def) or
              is_array_constructor(def);
          objectdef:
            result := is_object(def);
          setdef:
            result := not is_smallset(def);
          stringdef:
            result := tstringdef(def).stringtype in [st_shortstring, st_longstring];
          else
            ;
        end;
      end;

    function tcpuparamanager.ret_in_param(def: tdef; pd: tabstractprocdef): boolean;
      var
        tmpdef: tdef;
      begin
        if handle_common_ret_in_param(def,pd,result) then
          exit;

        { general rule: passed in registers -> returned in registers }
        result:=push_addr_param(vs_value,def,pd.proccalloption);
      end;

    procedure tcpuparamanager.init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
      begin
        cur_stack_offset := 0;
        curintreg := RS_R4;
        curfloatreg := RS_F0;
        curmmreg := RS_NO;
      end;

    function tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
      var
        paraloc: pcgparalocation;
        retcgsize: tcgsize;
        nextfloatreg, nextintreg, nextmmreg: tsuperregister;
        stack_offset: aword;
      begin
        if set_common_funcretloc_info(p,forcetempdef,retcgsize,result) then
          exit;

         { in this case, it must be returned in registers as if it were passed
           as the first parameter }
         init_values(nextintreg,nextfloatreg,nextmmreg,stack_offset);
         create_paraloc_for_def(result,vs_value,result.def,nextfloatreg,nextintreg,stack_offset,false,false,side,p);
         { sanity check (LOC_VOID for empty records) }
         if not assigned(result.location) or
            not(result.location^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_VOID]) then
           internalerror(2022111918);
      end;

    function tcpuparamanager.create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint;
      var
        cur_stack_offset: aword;
        curintreg, curfloatreg, curmmreg : tsuperregister;
      begin
        init_values(curintreg, curfloatreg, curmmreg, cur_stack_offset);

        result := create_paraloc_info_intern(p, side, p.paras, curintreg, curfloatreg, curmmreg, cur_stack_offset, false);

        create_funcretloc_info(p, side);
      end;

    function tcpuparamanager.create_paraloc_info_intern(p: tabstractprocdef; side: tcallercallee; paras: tparalist; var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; isVararg : boolean): longint;
      var
        nextintreg, nextfloatreg, nextmmreg : tsuperregister;
        i: integer;
        hp: tparavarsym;
        paraloc: pcgparalocation;
        delphi_nestedfp: boolean;

      begin
{$IFDEF extdebug}
        if po_explicitparaloc in p.procoptions then
          internalerror(2022111919);
{$ENDIF extdebug}

        result := 0;
        nextintreg := curintreg;
        nextfloatreg := curfloatreg;
        nextmmreg := curmmreg;

        for i := 0 to paras.count - 1 do begin
          hp := tparavarsym(paras[i]);

          if (vo_has_explicit_paraloc in hp.varoptions) then begin
            internalerror(2022111920);
          end;

          { currently only support C-style array of const }
          if (p.proccalloption in [pocall_cdecl, pocall_cppdecl]) and
            is_array_of_const(hp.vardef) then begin
            paraloc := hp.paraloc[side].add_location;
            { hack: the paraloc must be valid, but is not actually used }
            paraloc^.loc := LOC_REGISTER;
            paraloc^.register := NR_R0;
            paraloc^.size := OS_ADDR;
            paraloc^.def := voidpointertype;
            break;
          end;
          delphi_nestedfp:=(vo_is_parentfp in hp.varoptions) and (po_delphi_nested_cc in p.procoptions);
          create_paraloc_for_def(hp.paraloc[side], hp.varspez, hp.vardef,
            nextfloatreg, nextintreg, cur_stack_offset, isVararg, delphi_nestedfp, side, p);
        end;

        curintreg := nextintreg;
        curfloatreg := nextfloatreg;
        curmmreg := nextmmreg;
        result := cur_stack_offset;
      end;

    procedure tcpuparamanager.create_paraloc_for_def(var para: TCGPara; varspez: tvarspez; paradef: tdef; var nextfloatreg, nextintreg: tsuperregister; var stack_offset: aword; const isVararg, forceintmem: boolean; const side: tcallercallee; const p: tabstractprocdef);
      var
        paracgsize: tcgsize;
        loc: tcgloc;
        paraloc: pcgparalocation;
        { def to use for all paralocs if <> nil }
        alllocdef,
        { def to use for the current paraloc }
        locdef,
        tmpdef,tmpdef1,tmpdef2: tdef;
        tmpdep1_size,tmpdep2_size,record_offset,para_same_num: integer;
        paralen: aint;
        firstparaloc,
        paraaligned: boolean;
      begin
        alllocdef:=nil;
        locdef:=nil;
        tmpdef1:=nil;
        tmpdef2:=nil;
        para.reset;
        para_same_num := 0;
        record_offset := 0;
        { have we ensured that the next parameter location will be aligned to the
          next 8 byte boundary? }
        paraaligned:=false;
        if push_addr_param(varspez, paradef, p.proccalloption) then
          begin
            paradef := cpointerdef.getreusable_no_free(paradef);
            loc := LOC_REGISTER;
            paracgsize := OS_ADDR;
            paralen := tcgsize2size[OS_ADDR];
          end
        else
          begin
            if not is_special_array(paradef) then
              paralen := paradef.size
            else
              paralen := tcgsize2size[def_cgsize(paradef)];

            if (paradef.typ=recorddef) and
               tabstractrecordsymtable(tabstractrecorddef(paradef).symtable).has_single_field(tmpdef) and
               (tmpdef.typ=floatdef) then
              begin
                paradef:=tmpdef;
                loc:=getparaloc(paradef);
                paracgsize:=def_cgsize(paradef)
              end
            else if (((paradef.typ=arraydef) and not
                    is_special_array(paradef)) or
                    (paradef.typ=recorddef) and (varspez in [vs_value,vs_const]) ) then
              begin
                { general fallback rule: pass aggregate types in integer registers
                  without special adjustments (incl. Darwin h) }
                loc:=LOC_REGISTER;
                paracgsize:=int_cgsize(paralen);
                { Check if the element types in the record are the same}
                if paralen <= 16 then
                  para_same_num := tabstractrecordsymtable(tabstractrecorddef(paradef).symtable).has_double_field(tmpdef1, tmpdef2, record_offset);
                if para_same_num <> 0 then
                  begin
                    if (((tmpdef1.typ = floatdef) or (tmpdef2.typ = floatdef)) and (nextfloatreg > RS_F7)) then
                      para_same_num := 0;
                  end;
                if ((para_same_num <> 0) and (record_offset <= 8))then
                  begin
                    { Floating point elements less than two will be passed through the floating point register}
                    if tmpdef1.typ = floatdef then
                      begin
                        loc:=LOC_FPUREGISTER;
                        paracgsize:=int_float_cgsize(paralen);
                      end;
                    if ((tmpdef1.typ<>floatdef) and (tmpdef2.typ<>floatdef) and (para_same_num=1))then
                      para_same_num := 2;
                  end;
              end
            else
              begin
                loc:=getparaloc(paradef);
                paracgsize:=def_cgsize(paradef);
                { for things like formaldef }
                if (paracgsize=OS_NO) then
                  begin
                    paracgsize:=OS_ADDR;
                    paralen:=tcgsize2size[OS_ADDR];
                  end;
              end
          end;

        { patch FPU values into integer registers if we are processing varargs }
        if (isVararg) and (paradef.typ = floatdef) then
          begin
            loc := LOC_REGISTER;
            if paracgsize = OS_F64 then
              paracgsize := OS_64
            else
              paracgsize := OS_32;
          end;

        para.alignment := std_param_align;
        para.size := paracgsize;
        para.intsize := paralen;
        para.def := paradef;
        if (paralen = 0) then
          if (paradef.typ = recorddef) then
            begin
              paraloc := para.add_location;
              paraloc^.loc := LOC_VOID;
            end
          else
            internalerror(2022111921);

        if not assigned(alllocdef) then
          locdef:=paradef
        else
          begin
            locdef:=alllocdef;
            paracgsize:=def_cgsize(locdef);
          end;
        firstparaloc:=true;

        // Parameters passed in 2 registers are passed in a register starting with an even number.
        if isVararg and
           (paralen > 8) and
           (loc = LOC_REGISTER) and
           (nextintreg <= RS_R11) and
           odd(nextintreg) then
          inc(nextintreg);

        { can become < 0 for e.g. 3-byte records }
        while paralen > 0 do
          begin
            paraloc := para.add_location;
            { In case of po_delphi_nested_cc, the parent frame pointer
              is always passed on the stack. }
            if (loc = LOC_REGISTER) and
               (nextintreg <= RS_R11) and
               not forceintmem then
              begin
                paraloc^.loc := loc;

                { make sure we don't lose whether or not the type is signed }
                if (paracgsize <> OS_NO) and
                   (paradef.typ <> orddef) and
                   not assigned(alllocdef) then
                  begin
                    paracgsize := int_cgsize(paralen);
                    locdef:=get_paraloc_def(paradef, paralen, firstparaloc);
                  end;
                if para_same_num = 1 then
                  begin
                    paraloc^.size := int_cgsize(record_offset);
                    paraloc^.def := locdef;
                    para_same_num := 0;
                    {set for next element}
                    if tmpdef2.typ = floatdef then
                      begin
                        loc := LOC_FPUREGISTER;
                        paracgsize := int_float_cgsize(paralen - record_offset);
                      end
                    else
                      internalerror(2022082601);
                  end
                else if (paracgsize in [OS_NO, OS_128, OS_S128]) then
                  begin
                    if (paralen>4) then
                      begin
                        paraloc^.size := OS_INT;
                        paraloc^.def := osuinttype;
                      end
                    else
                      begin
                        { for 3-byte records aligned in the lower bits of register }
                        paraloc^.size := OS_32;
                        paraloc^.def := u32inttype;
                      end;
                  end
                else
                  begin
                    paraloc^.size := paracgsize;
                    paraloc^.def := locdef;
                  end;

                paraloc^.register := newreg(R_INTREGISTER, nextintreg, R_SUBNONE);
                inc(nextintreg);
                dec(paralen, tcgsize2size[paraloc^.size]);
              end
            else if (loc = LOC_FPUREGISTER) and
                    (nextfloatreg <= RS_F7) then
              begin
                paraloc^.loc := loc;
                if para_same_num = 1 then
                  begin
                    paraloc^.size := int_float_cgsize(record_offset);
                    if record_offset = 8 then
                      paraloc^.def := s64floattype
                    else
                      paraloc^.def := s32floattype;
                    para_same_num := 0;
                    {set for next element}
                    if tmpdef2.typ <> floatdef then
                      begin
                        loc := LOC_REGISTER;
                        paracgsize:=int_cgsize(paralen - record_offset);
                      end
                    else
                      internalerror(2022082602);
                  end
                else if((paracgsize = OS_F128) and (para_same_num = 2)) then
                  begin
                    paraloc^.size := OS_FLOAT;
                    paraloc^.def := s64floattype;
                  end
                else if((paracgsize = OS_F64) and (para_same_num = 2)) then
                  begin
                    paraloc^.size := OS_F32;
                    paraloc^.def := s32floattype;
                  end
                else
                  begin
                    paraloc^.size := paracgsize;
                    paraloc^.def := locdef;
                  end;
                paraloc^.register := newreg(R_FPUREGISTER, nextfloatreg, R_SUBWHOLE);
                inc(nextfloatreg);
                dec(paralen, tcgsize2size[paraloc^.size]);
              end
            else if (loc = LOC_MMREGISTER) then
              begin
                { no mm registers }
                internalerror(2022111922);
              end
            else
              begin
                { either LOC_REFERENCE, or one of the above which must be passed on the
                  stack because of insufficient registers }
                paraloc^.loc := LOC_REFERENCE;
                case loc of
                  LOC_FPUREGISTER:
                    begin
                      paraloc^.size:=int_float_cgsize(paralen);
                      case paraloc^.size of
                        OS_F32: paraloc^.def:=s32floattype;
                        OS_F64: paraloc^.def:=s64floattype;
                      else
                        internalerror(2022111923);
                      end;
                    end;
                  LOC_REGISTER,
                  LOC_REFERENCE:
                    begin
                      paraloc^.size:=int_cgsize(paralen);
                      paraloc^.def:=get_paraloc_def(paradef, paralen, firstparaloc);
                    end;
                else
                  internalerror(2022111924);
                end;
                if (side = callerside) then
                  paraloc^.reference.index := NR_STACK_POINTER_REG
                else
                  begin
                    { during procedure entry, NR_OLD_STACK_POINTER_REG contains the old stack pointer }
                    paraloc^.reference.index := NR_FRAME_POINTER_REG;
                    { create_paraloc_info_intern might be also called when being outside of
                      code generation so current_procinfo might be not set }
                    if assigned(current_procinfo) then
                      tloongarch64procinfo(current_procinfo).needs_frame_pointer := true;
                  end;
                paraloc^.reference.offset := stack_offset;

                { align temp contents to next register size }
                if not paraaligned then
                  inc(stack_offset, align(paralen, 8))
                else
                  inc(stack_offset, paralen);
                paralen := 0;
              end;
            firstparaloc:=false;
          end;
      end;

    function tcpuparamanager.create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee; varargspara: tvarargsparalist): longint;
      var
        cur_stack_offset: aword;
        parasize, l: longint;
        curintreg, firstfloatreg, curfloatreg, curmmreg: tsuperregister;
        i: integer;
        hp: tparavarsym;
        paraloc: pcgparalocation;
      begin
        init_values(curintreg, curfloatreg, curmmreg, cur_stack_offset);
        firstfloatreg := curfloatreg;

        result := create_paraloc_info_intern(p, side, p.paras, curintreg, curfloatreg, curmmreg, cur_stack_offset, false);
        if (p.proccalloption in [pocall_cdecl, pocall_cppdecl, pocall_mwpascal]) then
          begin
            { just continue loading the parameters in the registers }
            if assigned(varargspara) then
              begin
                if side=callerside then
                  result := create_paraloc_info_intern(p, side, varargspara, curintreg, curfloatreg, curmmreg, cur_stack_offset, true)
                else
                  internalerror(2022111925);
                if curfloatreg <> firstfloatreg then
                  include(varargspara.varargsinfo, va_uses_float_reg);
              end;
            { varargs routines have to reserve at least 64 bytes for the RiscV ABI }
            if (result < 64) then
              result := 64;
          end
        else
          internalerror(2022111926);

        create_funcretloc_info(p, side);
      end;

    function tcpuparamanager.parseparaloc(p: tparavarsym; const s: string): boolean;
      begin
        internalerror(2022111927);
        result := true;
     end;


begin
  paramanager := tcpuparamanager.create;
end.