freepascal.compiler/compiler/llvm/llvmdef.pas

{
    Copyright (c) 2013 by Jonas Maebe

    This unit implements some LLVM type helper routines.

    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.

 ****************************************************************************
}

{$i fpcdefs.inc}

unit llvmdef;

interface

    uses
      cclasses,globtype,
      aasmbase,
      parabase,
      symbase,symtype,symdef,
      llvmbase;

   type
     { there are three different circumstances in which procdefs are used:
        a) definition of a procdef that's implemented in the current module
        b) declaration of an external routine that's called in the current one
        c) alias declaration of a procdef implemented in the current module
        d) defining a procvar type
       The main differences between the contexts are:
        a) information about sign extension of result type, proc name, parameter names & sign-extension info & types
        b) information about sign extension of result type, proc name, no parameter names, with parameter sign-extension info & types
        c) no information about sign extension of result type, proc name, no parameter names, no information about sign extension of parameters, parameter types
        d) no information about sign extension of result type, no proc name, no parameter names, no information about sign extension of parameters, parameter types
      }
     tllvmprocdefdecltype = (lpd_def,lpd_decl,lpd_alias,lpd_procvar);

    { returns the identifier to use as typename for a def in llvm (llvm only
      allows naming struct types) -- only supported for defs with a typesym, and
      only for tabstractrecorddef descendantds and complex procvars }
    function llvmtypeidentifier(def: tdef): TSymStr;

    { encode a type into the internal format used by LLVM (for a type
      declaration) }
    function llvmencodetypedecl(def: tdef): TSymStr;

    { same as above, but use a type name if possible (for any use) }
    function llvmencodetypename(def: tdef): TSymStr;

    { encode a procdef/procvardef into the internal format used by LLVM }
    function llvmencodeproctype(def: tabstractprocdef; const customname: TSymStr; pddecltype: tllvmprocdefdecltype): TSymStr;
    { incremental version of the above }
    procedure llvmaddencodedproctype(def: tabstractprocdef; const customname: TSymStr; pddecltype: tllvmprocdefdecltype; var encodedstr: TSymStr);

    { function result types may have to be represented differently, e.g. a
      record consisting of 4 longints must be returned as a record consisting of
      two int64's on x86-64. This function is used to create (and reuse)
      temporary recorddefs for such purposes.}
    function llvmgettemprecorddef(fieldtypes: tfplist; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;

    { get the llvm type corresponding to a parameter, e.g. a record containing
      two integer int64 for an arbitrary record split over two individual int64
      parameters, or an int32 for an int16 parameter on a platform that requires
      such parameters to be zero/sign extended. The second parameter can be used
      to get the type before zero/sign extension, as e.g. required to generate
      function declarations. }
    function llvmgetcgparadef(const cgpara: tcgpara; beforevalueext: boolean): tdef;

    { can be used to extract the value extension info from acgpara. Pass in
      the def of the cgpara as first parameter and a local variable holding
      a copy of the def of the location (value extension only makes sense for
      ordinal parameters that are smaller than a single location). The routine
      will return the def of the location without sign extension (if applicable)
      and the kind of sign extension that was originally performed in the
      signext parameter }
    procedure llvmextractvalueextinfo(paradef: tdef; var paralocdef: tdef; out signext: tllvmvalueextension);

    { returns whether a paraloc should be translated into an llvm "byval"
      parameter. These are declared as pointers to a particular type, but
      usually turned into copies onto the stack. The exact behaviour for
      parameters that should be passed in registers is undefined and depends on
      the platform, and furthermore this modifier sometimes inhibits
      optimizations.  As a result,we only use it for aggregate parameters of
      which we know that they should be passed on the stack }
    function llvmbyvalparaloc(paraloc: pcgparalocation): boolean;

    { returns whether a def is representated by an aggregate type in llvm
      (struct, array) }
    function llvmaggregatetype(def: tdef): boolean;

    function llvmconvop(var fromsize, tosize: tdef; inregs: boolean): tllvmop;

    { mangle a global identifier so that it's recognised by LLVM as a global
      (in the sense of module-global) label and so that it won't mangle the
      name further according to platform conventions (we already did that) }
    function llvmmangledname(const s: TSymStr): TSymStr;

    function llvmasmsymname(const sym: TAsmSymbol): TSymStr;


implementation

  uses
    cutils,constexp,
    verbose,systems,
    fmodule,
    symtable,symconst,symsym,
    llvmsym,hlcgobj,
    defutil,blockutl,cgbase,paramgr;


{******************************************************************
                          Type encoding
*******************************************************************}

  function llvmtypeidentifier(def: tdef): TSymStr;
    begin
      if not assigned(def.typesym) then
        internalerror(2015041901);
      result:='%"typ.'+def.fullownerhierarchyname+def.typesym.realname+'"'
    end;


  function llvmaggregatetype(def: tdef): boolean;
    begin
      result:=
        (def.typ in [recorddef,filedef,variantdef]) or
        ((def.typ=arraydef) and
         not is_dynamic_array(def)) or
        ((def.typ=setdef) and
         not is_smallset(def)) or
        is_shortstring(def) or
        is_object(def) or
        ((def.typ=procvardef) and
         not tprocvardef(def).is_addressonly)
    end;


  function llvmconvop(var fromsize, tosize: tdef; inregs: boolean): tllvmop;
    var
      fromregtyp,
      toregtyp: tregistertype;
      frombytesize,
      tobytesize: asizeint;
    begin
      fromregtyp:=chlcgobj.def2regtyp(fromsize);
      toregtyp:=chlcgobj.def2regtyp(tosize);
      { int to pointer or vice versa }
      if fromregtyp=R_ADDRESSREGISTER then
        begin
          case toregtyp of
            R_INTREGISTER:
              result:=la_ptrtoint;
            R_ADDRESSREGISTER:
              result:=la_bitcast;
            else
              result:=la_ptrtoint_to_x;
            end;
        end
      else if toregtyp=R_ADDRESSREGISTER then
        begin
          case fromregtyp of
            R_INTREGISTER:
              result:=la_inttoptr;
            R_ADDRESSREGISTER:
              result:=la_bitcast;
            else
              result:=la_x_to_inttoptr;
            end;
        end
      else
        begin
          { treat comp and currency as extended in registers (see comment at start
            of thlgcobj.a_loadfpu_ref_reg) }
          if inregs and
             (fromsize.typ=floatdef) then
            begin
              if tfloatdef(fromsize).floattype in [s64comp,s64currency] then
                fromsize:=sc80floattype;
              { at the value level, s80real and sc80real are the same }
              if tfloatdef(fromsize).floattype<>s80real then
                frombytesize:=fromsize.size
              else
                frombytesize:=sc80floattype.size;
            end
          else
            frombytesize:=fromsize.size;

          if inregs and
             (tosize.typ=floatdef) then
            begin
              if tfloatdef(tosize).floattype in [s64comp,s64currency] then
                tosize:=sc80floattype;
              if tfloatdef(tosize).floattype<>s80real then
                tobytesize:=tosize.size
              else
                tobytesize:=sc80floattype.size;
            end
          else
            tobytesize:=tosize.size;

          { need zero/sign extension, float truncation or plain bitcast? }
          if tobytesize<>frombytesize then
            begin
              case fromregtyp of
                R_FPUREGISTER,
                R_MMREGISTER:
                  begin
                    { todo: update once we support vectors }
                    if not(toregtyp in [R_FPUREGISTER,R_MMREGISTER]) then
                      internalerror(2014062203);
                    if tobytesize<frombytesize then
                      result:=la_fptrunc
                    else
                      result:=la_fpext
                  end;
                else
                  begin
                    if tobytesize<frombytesize then
                      result:=la_trunc
                    else if is_signed(fromsize) then
                      { fromsize is signed -> sign extension }
                      result:=la_sext
                    else
                      result:=la_zext;
                  end;
              end;
            end
          else if (fromsize=llvmbool1type) and
                  (tosize<>llvmbool1type) then
            begin
              if is_cbool(tosize) then
                result:=la_sext
              else
                result:=la_zext
            end
          else if (tosize=llvmbool1type) and
                  (fromsize<>llvmbool1type) then
            begin
              { would have to compare with 0, can't just take the lowest bit }
              if is_cbool(fromsize) then
                internalerror(2016052001)
              else
                result:=la_trunc
            end
          else
            result:=la_bitcast;
        end;
    end;


  function llvmmangledname(const s: TSymStr): TSymStr;
    begin
      if copy(s,1,length('llvm.'))<>'llvm.' then
        result:='@"\01'+s+'"'
      else
        result:='@'+s
    end;


  function llvmasmsymname(const sym: TAsmSymbol): TSymStr;
    begin
      { AT_ADDR and AT_LABEL represent labels in the code, which have
        a different type in llvm compared to (global) data labels }
      if sym.bind=AB_TEMP then
        result:='%'+sym.name
      else if not(sym.typ in [AT_LABEL,AT_ADDR]) then
        result:=llvmmangledname(sym.name)
      else
        result:='label %'+sym.name;
    end;


  function llvmbyvalparaloc(paraloc: pcgparalocation): boolean;
    begin
      { "byval" is broken for register paras on several platforms in llvm
        (search for "byval" in llvm's bug tracker). Additionally, it should only
        be used to pass aggregate parameters on the stack, because it reportedly
        inhibits llvm's midlevel optimizers.

        Exception (for now?): parameters that have special shifting
          requirements, because modelling those in llvm is not easy (and clang
          nor llvm-gcc seem to do so either) }
      result:=
        ((paraloc^.loc=LOC_REFERENCE) and
         llvmaggregatetype(paraloc^.def)) or
        ((paraloc^.loc in [LOC_REGISTER,LOC_CREGISTER]) and
         (paraloc^.shiftval<>0))
    end;


  procedure llvmaddencodedabstractrecordtype(def: tabstractrecorddef; var encodedstr: TSymStr); forward;

  type
    tllvmencodeflag = (lef_inaggregate, lef_noimplicitderef, lef_typedecl);
    tllvmencodeflags = set of tllvmencodeflag;

    procedure llvmaddencodedtype_intern(def: tdef; const flags: tllvmencodeflags; var encodedstr: TSymStr);
      var
        elesize: asizeint;
      begin
        case def.typ of
          stringdef :
            begin
              case tstringdef(def).stringtype of
                st_widestring,
                st_unicodestring:
                  { the variable does not point to the header, but to a
                    null-terminated string/array with undefined bounds }
                  encodedstr:=encodedstr+'i16*';
                st_ansistring:
                  encodedstr:=encodedstr+'i8*';
                st_shortstring:
                  { length byte followed by string bytes }
                  if tstringdef(def).len>0 then
                    encodedstr:=encodedstr+'['+tostr(tstringdef(def).len+1)+' x i8]'
                  else
                    encodedstr:=encodedstr+'[0 x i8]';
                else
                  internalerror(2013100201);
              end;
            end;
          enumdef:
            begin
              encodedstr:=encodedstr+'i'+tostr(def.size*8);
            end;
          orddef :
            begin
              if is_void(def) then
                encodedstr:=encodedstr+'void'
              { mainly required because comparison operations return i1, and
                we need a way to represent the i1 type in Pascal. We don't
                reuse pasbool8type, because putting an i1 in a record or
                passing it as a parameter may result in unexpected behaviour }
              else if def=llvmbool1type then
                encodedstr:=encodedstr+'i1'
              else
                encodedstr:=encodedstr+'i'+tostr(def.size*8);
            end;
          pointerdef :
            begin
              if is_voidpointer(def) then
                encodedstr:=encodedstr+'i8*'
              else
                begin
                  llvmaddencodedtype_intern(tpointerdef(def).pointeddef,[],encodedstr);
                  encodedstr:=encodedstr+'*';
                end;
            end;
          floatdef :
            begin
              case tfloatdef(def).floattype of
                s32real:
                  encodedstr:=encodedstr+'float';
                s64real:
                  encodedstr:=encodedstr+'double';
                { necessary to be able to force our own size/alignment }
                s80real:
                  { prevent llvm from allocating the standard ABI size for
                    extended }
                  if lef_inaggregate in flags then
                    encodedstr:=encodedstr+'[10 x i8]'
                  else
                    encodedstr:=encodedstr+'x86_fp80';
                sc80real:
                  encodedstr:=encodedstr+'x86_fp80';
                s64comp,
                s64currency:
                  encodedstr:=encodedstr+'i64';
                s128real:
{$if defined(powerpc) or defined(powerpc128)}
                  encodedstr:=encodedstr+'ppc_fp128';
{$else}
                  encodedstr:=encodedstr+'fp128';
{$endif}
                else
                  internalerror(2013100202);
              end;
            end;
          filedef :
            begin
              case tfiledef(def).filetyp of
                ft_text    :
                  llvmaddencodedtype_intern(search_system_type('TEXTREC').typedef,[lef_inaggregate]+[lef_typedecl]*flags,encodedstr);
                ft_typed,
                ft_untyped :
                  llvmaddencodedtype_intern(search_system_type('FILEREC').typedef,[lef_inaggregate]+[lef_typedecl]*flags,encodedstr);
                else
                  internalerror(2013100203);
              end;
            end;
          recorddef :
            begin
              { avoid endlessly recursive definitions }
              if assigned(def.typesym) and
                 ((lef_inaggregate in flags) or
                  not(lef_typedecl in flags)) then
                encodedstr:=encodedstr+llvmtypeidentifier(def)
              else
                llvmaddencodedabstractrecordtype(trecorddef(def),encodedstr);
            end;
          variantdef :
            begin
              llvmaddencodedtype_intern(search_system_type('TVARDATA').typedef,[lef_inaggregate]+[lef_typedecl]*flags,encodedstr);
            end;
          classrefdef :
            begin
              if is_class(tclassrefdef(def).pointeddef) then
                begin
                  llvmaddencodedtype_intern(tobjectdef(tclassrefdef(def).pointeddef).vmt_def,flags,encodedstr);
                  encodedstr:=encodedstr+'*';
                end
              else if is_objcclass(tclassrefdef(def).pointeddef) then
                llvmaddencodedtype_intern(objc_idtype,flags,encodedstr)
              else
                encodedstr:=encodedstr+'i8*'
            end;
          setdef :
            begin
              { just an array as far as llvm is concerned; don't use a "packed
                array of i1" or so, this requires special support in backends
                and guarantees nothing about the internal format }
              if is_smallset(def) then
                llvmaddencodedtype_intern(cgsize_orddef(def_cgsize(def)),[lef_inaggregate],encodedstr)
              else
                encodedstr:=encodedstr+'['+tostr(tsetdef(def).size)+' x i8]';
            end;
          formaldef :
            begin
              { var/const/out x (always treated as "pass by reference" -> don't
                add extra "*" here) }
              encodedstr:=encodedstr+'i8';
            end;
          arraydef :
            begin
              if is_array_of_const(def) then
                begin
                  encodedstr:=encodedstr+'[0 x ';
                  llvmaddencodedtype_intern(search_system_type('TVARREC').typedef,[lef_inaggregate],encodedstr);
                  encodedstr:=encodedstr+']';
                end
              else if is_open_array(def) then
                begin
                  encodedstr:=encodedstr+'[0 x ';
                  llvmaddencodedtype_intern(tarraydef(def).elementdef,[lef_inaggregate],encodedstr);
                  encodedstr:=encodedstr+']';
                end
              else if is_dynamic_array(def) then
                begin
                  llvmaddencodedtype_intern(tarraydef(def).elementdef,[],encodedstr);
                  encodedstr:=encodedstr+'*';
                end
              else if is_packed_array(def) and
                      (tarraydef(def).elementdef.typ in [enumdef,orddef]) then
                begin
                  elesize:=packedbitsloadsize(tarraydef(def).elementdef.packedbitsize);
                  encodedstr:=encodedstr+'['+tostr(tarraydef(def).size div elesize)+' x ';
                  { encode as an array of integers with the size on which we
                    perform the packedbits operations }
                  llvmaddencodedtype_intern(cgsize_orddef(int_cgsize(elesize)),[lef_inaggregate],encodedstr);
                  encodedstr:=encodedstr+']';
                end
              else
                begin
                  encodedstr:=encodedstr+'['+tostr(tarraydef(def).elecount)+' x ';
                  llvmaddencodedtype_intern(tarraydef(def).elementdef,[lef_inaggregate],encodedstr);
                  encodedstr:=encodedstr+']';
                end;
            end;
          procdef,
          procvardef :
            begin
              if (def.typ=procdef) or
                 tprocvardef(def).is_addressonly then
                begin
                  llvmaddencodedproctype(tabstractprocdef(def),'',lpd_procvar,encodedstr);
                  if def.typ=procvardef then
                    encodedstr:=encodedstr+'*';
                end
              else if ((lef_inaggregate in flags) or
                  not(lef_typedecl in flags)) and
                 assigned(tprocvardef(def).typesym) then
                begin
                  { in case the procvardef recursively references itself, e.g.
                    via a pointer }
                  encodedstr:=encodedstr+llvmtypeidentifier(def);
                  { blocks are implicit pointers }
                  if is_block(def) then
                    encodedstr:=encodedstr+'*'
                end
              else if is_block(def) then
                begin
                  llvmaddencodedtype_intern(get_block_literal_type_for_proc(tabstractprocdef(def)),flags,encodedstr);
                end
              else
                begin
                  encodedstr:=encodedstr+'<{';
                  { code pointer }
                  llvmaddencodedproctype(tabstractprocdef(def),'',lpd_procvar,encodedstr);
                  { data pointer (maybe todo: generate actual layout if
                    available) }
                  encodedstr:=encodedstr+'*, i8*}>';
                end;
            end;
          objectdef :
            case tobjectdef(def).objecttype of
              odt_class,
              odt_objcclass,
              odt_object,
              odt_cppclass:
                begin
                  if not(lef_typedecl in flags) and
                     assigned(def.typesym) then
                    encodedstr:=encodedstr+llvmtypeidentifier(def)
                  else
                    llvmaddencodedabstractrecordtype(tabstractrecorddef(def),encodedstr);
                  if ([lef_typedecl,lef_noimplicitderef]*flags=[]) and
                     is_implicit_pointer_object_type(def) then
                    encodedstr:=encodedstr+'*'
                end;
              odt_interfacecom,
              odt_interfacecorba,
              odt_dispinterface:
                begin
                  { type is a pointer to a pointer to the vmt }
                  llvmaddencodedtype_intern(tobjectdef(def).vmt_def,flags,encodedstr);
                  if ([lef_typedecl,lef_noimplicitderef]*flags=[]) then
                    encodedstr:=encodedstr+'**';
                end;
              odt_interfacecom_function,
              odt_interfacecom_property,
              odt_objcprotocol:
                begin
                  { opaque for now }
                  encodedstr:=encodedstr+'i8*'
                end;
              else
                internalerror(2013100601);
            end;
          undefineddef,
          errordef :
            internalerror(2013100604);
        else
          internalerror(2013100603);
        end;
      end;


    function llvmencodetypename(def: tdef): TSymStr;
      begin
        result:='';
        llvmaddencodedtype_intern(def,[],result);
      end;


    procedure llvmaddencodedtype(def: tdef; inaggregate: boolean; var encodedstr: TSymStr);
      var
        flags: tllvmencodeflags;
      begin
        if inaggregate then
          flags:=[lef_inaggregate]
        else
          flags:=[];
        llvmaddencodedtype_intern(def,flags,encodedstr);
      end;


    procedure llvmaddencodedabstractrecordtype(def: tabstractrecorddef; var encodedstr: TSymStr);
      var
        st: tllvmshadowsymtable;
        symdeflist: tfpobjectlist;
        i: longint;
        nopacked: boolean;
      begin
        st:=tabstractrecordsymtable(def.symtable).llvmst;
        symdeflist:=st.symdeflist;

        nopacked:=df_llvm_no_struct_packing in def.defoptions;
        if nopacked then
          encodedstr:=encodedstr+'{ '
        else
          encodedstr:=encodedstr+'<{ ';
        if symdeflist.count>0 then
          begin
            i:=0;
            if (def.typ=objectdef) and
               assigned(tobjectdef(def).childof) and
               is_class_or_interface_or_dispinterface(tllvmshadowsymtableentry(symdeflist[0]).def) then
              begin
                { insert the struct for the class rather than a pointer to the struct }
                if (tllvmshadowsymtableentry(symdeflist[0]).def.typ<>objectdef) then
                  internalerror(2008070601);
                llvmaddencodedtype_intern(tllvmshadowsymtableentry(symdeflist[0]).def,[lef_inaggregate,lef_noimplicitderef],encodedstr);
                inc(i);
              end;
            while i<symdeflist.count do
              begin
                if i<>0 then
                  encodedstr:=encodedstr+', ';
                llvmaddencodedtype_intern(tllvmshadowsymtableentry(symdeflist[i]).def,[lef_inaggregate],encodedstr);
                inc(i);
              end;
          end;
        if nopacked then
          encodedstr:=encodedstr+' }'
        else
          encodedstr:=encodedstr+' }>';
      end;


    procedure llvmextractvalueextinfo(paradef: tdef; var paralocdef: tdef; out signext: tllvmvalueextension);
      begin
        { implicit zero/sign extension for ABI compliance? (yes, if the size
          of a paraloc is larger than the size of the entire parameter) }
        if is_ordinal(paradef) and
           is_ordinal(paralocdef) and
           (paradef.size<paralocdef.size) then
          begin
            paralocdef:=paradef;
            if is_signed(paradef) then
              signext:=lve_signext
            else
              signext:=lve_zeroext
          end
        else
          signext:=lve_none;
      end;


    procedure llvmaddencodedparaloctype(hp: tparavarsym; proccalloption: tproccalloption; withparaname, withattributes: boolean; var first: boolean; var encodedstr: TSymStr);
      var
        paraloc: PCGParaLocation;
        signext: tllvmvalueextension;
        usedef: tdef;
      begin
        if (proccalloption in cdecl_pocalls) and
           is_array_of_const(hp.vardef) then
          begin
            if not first then
               encodedstr:=encodedstr+', '
            else
              first:=false;
            encodedstr:=encodedstr+'...';
            exit
          end;
        if withparaname then
          paraloc:=hp.paraloc[calleeside].location
        else
          paraloc:=hp.paraloc[callerside].location;
        repeat
          usedef:=paraloc^.def;
          llvmextractvalueextinfo(hp.vardef,usedef,signext);
          { implicit zero/sign extension for ABI compliance? }
          if not first then
             encodedstr:=encodedstr+', '
          else
            first:=false;
          llvmaddencodedtype_intern(usedef,[],encodedstr);
          { in case signextstr<>'', there should be only one paraloc -> no need
            to clear (reason: it means that the paraloc is larger than the
            original parameter) }
          if withattributes then
            encodedstr:=encodedstr+llvmvalueextension2str[signext];
          { sret: hidden pointer for structured function result }
          if vo_is_funcret in hp.varoptions then
            begin
              { "sret" is only valid for the firstparameter, while in FPC this
                can sometimes be second one (self comes before). In general,
                this is not a problem: we can just leave out sret, which means
                the result will be a bit less well optimised), but it is for
                AArch64: there, the sret parameter must be passed in a different
                register (-> paranr_result is smaller than paranr_self for that
                platform in symconst) }
{$ifdef aarch64}
              if not first then
                internalerror(2015101404);
{$endif aarch64}
              if withattributes then
                 if first then
                   encodedstr:=encodedstr+' sret'
                 else { we can add some other attributes to optimise things,}
                   encodedstr:=encodedstr+' noalias nocapture';
            end
          else if not paramanager.push_addr_param(hp.varspez,hp.vardef,proccalloption) and
             llvmbyvalparaloc(paraloc) then
            begin
              if withattributes then
                encodedstr:=encodedstr+'* byval'
              else
                encodedstr:=encodedstr+'*';
            end;
          if withparaname then
            begin
              if paraloc^.llvmloc.loc<>LOC_REFERENCE then
                internalerror(2014010803);
              encodedstr:=encodedstr+' '+llvmasmsymname(paraloc^.llvmloc.sym);
            end;
          paraloc:=paraloc^.next;
        until not assigned(paraloc);
      end;


    function llvmencodeproctype(def: tabstractprocdef; const customname: TSymStr; pddecltype: tllvmprocdefdecltype): TSymStr;
      begin
        result:='';
        llvmaddencodedproctype(def,customname,pddecltype,result);
      end;


    procedure llvmaddencodedproctype(def: tabstractprocdef; const customname: TSymStr; pddecltype: tllvmprocdefdecltype; var encodedstr: TSymStr);
      var
        usedef: tdef;
        paranr: longint;
        hp: tparavarsym;
        signext: tllvmvalueextension;
        useside: tcallercallee;
        first: boolean;
      begin
        { when writing a definition, we have to write the parameter names, and
          those are only available on the callee side. In all other cases,
          we are at the callerside }
        if pddecltype=lpd_def then
          useside:=calleeside
        else
          useside:=callerside;
        def.init_paraloc_info(useside);
        first:=true;
        { function result (return-by-ref is handled explicitly) }
        if not paramanager.ret_in_param(def.returndef,def) then
          begin
            usedef:=llvmgetcgparadef(def.funcretloc[useside],false);
            llvmextractvalueextinfo(def.returndef,usedef,signext);
            { specifying result sign extention information for an alias causes
              an error for some reason }
            if pddecltype in [lpd_decl,lpd_def] then
              encodedstr:=encodedstr+llvmvalueextension2str[signext];
            encodedstr:=encodedstr+' ';
            llvmaddencodedtype_intern(usedef,[],encodedstr);
          end
        else
          begin
            encodedstr:=encodedstr+' ';
            llvmaddencodedtype(voidtype,false,encodedstr);
          end;
        encodedstr:=encodedstr+' ';
        { add procname? }
        if (pddecltype in [lpd_decl,lpd_def]) and
           (def.typ=procdef) then
          if customname='' then
            encodedstr:=encodedstr+llvmmangledname(tprocdef(def).mangledname)
          else
            encodedstr:=encodedstr+llvmmangledname(customname);
        encodedstr:=encodedstr+'(';
        { parameters }
        first:=true;
        for paranr:=0 to def.paras.count-1 do
          begin
            hp:=tparavarsym(def.paras[paranr]);
            llvmaddencodedparaloctype(hp,def.proccalloption,pddecltype in [lpd_def],not(pddecltype in [lpd_procvar,lpd_alias]),first,encodedstr);
          end;
        if po_varargs in def.procoptions then
          begin
            if not first then
              encodedstr:=encodedstr+', ';
            encodedstr:=encodedstr+'...';
          end;
        encodedstr:=encodedstr+')'
      end;


    function llvmgettemprecorddef(fieldtypes: tfplist; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;
      var
        i: longint;
        res: PHashSetItem;
        oldsymtablestack: tsymtablestack;
        hrecst: trecordsymtable;
        hdef: tdef;
        hrecdef: trecorddef;
        sym: tfieldvarsym;
        typename: string;
      begin
        typename:=internaltypeprefixName[itp_llvmstruct];
        for i:=0 to fieldtypes.count-1 do
          begin
            hdef:=tdef(fieldtypes[i]);
            case hdef.typ of
              orddef:
                case torddef(hdef).ordtype of
                  s8bit,
                  u8bit:
                    typename:=typename+'i8';
                  s16bit,
                  u16bit:
                    typename:=typename+'i16';
                  s32bit,
                  u32bit:
                    typename:=typename+'i32';
                  s64bit,
                  u64bit:
                    typename:=typename+'i64';
                  else
                    { other types should not appear currently, add as needed }
                    internalerror(2014012001);
                end;
              floatdef:
                case tfloatdef(hdef).floattype of
                  s32real:
                    typename:=typename+'f32';
                  s64real:
                    typename:=typename+'f64';
                  else
                    { other types should not appear currently, add as needed }
                    internalerror(2014012008);
                  end;
              pointerdef:
                typename:='p'+tostr(hdef.deflist_index);
              else
                { other types should not appear currently, add as needed }
                internalerror(2014012009);
            end;
          end;
        if not assigned(current_module) then
          internalerror(2014012002);
        res:=current_module.llvmdefs.FindOrAdd(@typename[1],length(typename));
        if not assigned(res^.Data) then
          begin
            res^.Data:=crecorddef.create_global_internal(typename,packrecords,
              recordalignmin,maxcrecordalign);
            for i:=0 to fieldtypes.count-1 do
              trecorddef(res^.Data).add_field_by_def('F'+tostr(i),tdef(fieldtypes[i]));
          end;
        trecordsymtable(trecorddef(res^.Data).symtable).addalignmentpadding;
        result:=trecorddef(res^.Data);
      end;


    function llvmgetcgparadef(const cgpara: tcgpara; beforevalueext: boolean): tdef;
      var
        retdeflist: tfplist;
        retloc: pcgparalocation;
        usedef: tdef;
        valueext: tllvmvalueextension;
      begin
        { single location }
        if not assigned(cgpara.location^.next) then
          begin
            { def of the location, except in case of zero/sign-extension }
            usedef:=cgpara.location^.def;
            if beforevalueext then
              llvmextractvalueextinfo(cgpara.def,usedef,valueext);
            { comp and currency are handled by the x87 in this case. They cannot
              be represented directly in llvm, and llvmdef translates them into
              i64 (since that's their storage size and internally they also are
              int64). Solve this by changing the type to s80real in the
              returndef/parameter declaration. }
            if (usedef.typ=floatdef) and
               (tfloatdef(usedef).floattype in [s64comp,s64currency]) then
              usedef:=s80floattype;
            result:=usedef;
            exit
          end;
        { multiple locations -> create temp record }
        retdeflist:=tfplist.create;
        retloc:=cgpara.location;
        repeat
          retdeflist.add(retloc^.def);
          retloc:=retloc^.next;
        until not assigned(retloc);
        result:=llvmgettemprecorddef(retdeflist,C_alignment,
          targetinfos[target_info.system]^.alignment.recordalignmin,
          targetinfos[target_info.system]^.alignment.maxCrecordalign);
        include(result.defoptions,df_llvm_no_struct_packing);
      end;


    function llvmencodetypedecl(def: tdef): TSymStr;
      begin
        result:='';
        llvmaddencodedtype_intern(def,[lef_typedecl],result);
      end;


end.