* insert type conversions in case a symbol is declared via 'external' as an

    alias for another symbol with a different type (such as
    FPC_ANSISTR_UNIQUE, which is defined as a function and referenced as a
    procedure)

git-svn-id: trunk@30781 -

compiler/llvm/llvmtype.pas

@@ -35,6 +35,7 @@ interface
       cclasses,globtype,
       aasmbase,aasmtai,aasmdata,
       symbase,symtype,symdef,symsym,
+      aasmllvm,aasmcnst,
       finput,
       dbgbase;
 
@@ -43,6 +44,19 @@ interface
     type
       TLLVMTypeInfo = class(TDebugInfo)
       protected
+        { using alias/external declarations it's possible to refer to the same
+          assembler symbol using multiple types:
+            function f(p: pointer): pointer; [public, alias: 'FPC_FUNC'];
+            procedure test(p: pointer); external name 'FPC_FUNC';
+
+          We have to insert the appropriate typecasts (per module) for LLVM in
+          this case. That can only be done after all code for a module has been
+          generated, as these alias declarations can appear anywhere }
+        asmsymtypes: THashSet;
+
+        procedure record_asmsym_def(sym: TAsmSymbol; def: tdef);
+        function  get_asmsym_def(sym: TAsmSymbol): tdef;
+
         function record_def(def:tdef): tdef;
 
         procedure appenddef_array(list:TAsmList;def:tarraydef);override;
@@ -64,9 +78,14 @@ interface
 
         procedure enum_membersyms_callback(p:TObject;arg:pointer);
 
-        procedure process_llvmins(deftypelist: tasmlist; p: tai);
-        procedure process_tai(deftypelist: tasmlist; p: tai);
-        procedure process_asmlist(deftypelist, asmlist: tasmlist);
+        procedure collect_llvmins_info(deftypelist: tasmlist; p: taillvm);
+        procedure collect_tai_info(deftypelist: tasmlist; p: tai);
+        procedure collect_asmlist_info(deftypelist, asmlist: tasmlist);
+
+        procedure insert_llvmins_typeconversions(p: taillvm);
+        procedure insert_typedconst_typeconversion(p: tai_abstracttypedconst);
+        procedure insert_tai_typeconversions(p: tai);
+        procedure insert_asmlist_typeconversions(list: tasmlist);
 
       public
         constructor Create;override;
@@ -81,13 +100,38 @@ implementation
       version,globals,verbose,systems,
       cpubase,cgbase,paramgr,
       fmodule,nobj,
-      defutil,symconst,symtable,
-      llvmbase, aasmllvm, aasmcnst;
+      defutil,defcmp,symconst,symtable,
+      llvmbase,llvmdef
+      ;
 
 {****************************************************************************
                               TDebugInfoDwarf
 ****************************************************************************}
 
+    procedure TLLVMTypeInfo.record_asmsym_def(sym: TAsmSymbol; def: tdef);
+      var
+        res: PHashSetItem;
+      begin
+        res:=asmsymtypes.FindOrAdd(@sym,sizeof(sym));
+        { if there are multiple definitions of the same symbol, we're in
+          trouble anyway, so don't bother checking whether data is already
+          assigned }
+        res^.Data:=def;
+      end;
+
+
+    function TLLVMTypeInfo.get_asmsym_def(sym: TAsmSymbol): tdef;
+      var
+        res: PHashSetItem;
+      begin
+        res:=asmsymtypes.Find(@sym,sizeof(sym));
+        { we must have a def for every used asmsym }
+        if not assigned(res) or
+           not assigned(res^.data) then
+          internalerror(2015042701);
+        result:=tdef(res^.Data);
+      end;
+
 
     function TLLVMTypeInfo.record_def(def:tdef): tdef;
       begin
@@ -103,11 +147,13 @@ implementation
     constructor TLLVMTypeInfo.Create;
       begin
         inherited Create;
+        asmsymtypes:=THashSet.Create(current_asmdata.AsmSymbolDict.Count,true,false);
       end;
 
 
     destructor TLLVMTypeInfo.Destroy;
       begin
+        asmsymtypes.free;
         inherited destroy;
       end;
 
@@ -120,44 +166,49 @@ implementation
         end;
       end;
 
-
-    procedure TLLVMTypeInfo.process_llvmins(deftypelist: tasmlist; p: tai);
+    procedure TLLVMTypeInfo.collect_llvmins_info(deftypelist: tasmlist; p: taillvm);
       var
         opidx, paraidx: longint;
         callpara: pllvmcallpara;
       begin
-        for opidx:=0 to taillvm(p).ops-1 do
-          case taillvm(p).oper[opidx]^.typ of
+        for opidx:=0 to p.ops-1 do
+          case p.oper[opidx]^.typ of
             top_def:
-              appenddef(deftypelist,taillvm(p).oper[opidx]^.def);
+              appenddef(deftypelist,p.oper[opidx]^.def);
             top_tai:
-              process_tai(deftypelist,taillvm(p).oper[opidx]^.ai);
+              collect_tai_info(deftypelist,p.oper[opidx]^.ai);
             top_para:
-              for paraidx:=0 to taillvm(p).oper[opidx]^.paras.count-1 do
+              for paraidx:=0 to p.oper[opidx]^.paras.count-1 do
                 begin
-                  callpara:=pllvmcallpara(taillvm(p).oper[opidx]^.paras[paraidx]);
+                  callpara:=pllvmcallpara(p.oper[opidx]^.paras[paraidx]);
                   appenddef(deftypelist,callpara^.def);
                 end;
           end;
       end;
 
 
-    procedure TLLVMTypeInfo.process_tai(deftypelist: tasmlist; p: tai);
+    procedure TLLVMTypeInfo.collect_tai_info(deftypelist: tasmlist; p: tai);
       begin
         case p.typ of
           ait_llvmalias:
-            appenddef(deftypelist,taillvmalias(p).def);
+            begin
+              appenddef(deftypelist,taillvmalias(p).def);
+              record_asmsym_def(taillvmalias(p).newsym,taillvmalias(p).def);
+            end;
           ait_llvmdecl:
-            appenddef(deftypelist,taillvmdecl(p).def);
+            begin
+              appenddef(deftypelist,taillvmdecl(p).def);
+              record_asmsym_def(taillvmdecl(p).namesym,taillvmdecl(p).def);
+            end;
           ait_llvmins:
-            process_llvmins(deftypelist,p);
+            collect_llvmins_info(deftypelist,taillvm(p));
           ait_typedconst:
             appenddef(deftypelist,tai_abstracttypedconst(p).def);
         end;
       end;
 
 
-    procedure TLLVMTypeInfo.process_asmlist(deftypelist, asmlist: tasmlist);
+    procedure TLLVMTypeInfo.collect_asmlist_info(deftypelist, asmlist: tasmlist);
       var
         hp: tai;
       begin
@@ -166,7 +217,149 @@ implementation
         hp:=tai(asmlist.first);
         while assigned(hp) do
           begin
-            process_tai(deftypelist,hp);
+            collect_tai_info(deftypelist,hp);
+            hp:=tai(hp.next);
+          end;
+      end;
+
+
+    function equal_llvm_defs(def1, def2: tdef): boolean;
+      var
+        def1str, def2str: TSymStr;
+      begin
+        if def1=def2 then
+          exit(true);
+        def1str:=llvmencodetypename(def1);
+        def2str:=llvmencodetypename(def2);
+        { normalise both type representations in case one is a procdef
+          and the other is a procvardef}
+        if def1.typ=procdef then
+          def1str:=def1str+'*';
+        if def2.typ=procdef then
+          def2str:=def2str+'*';
+        result:=def1str=def2str;
+      end;
+
+
+    procedure TLLVMTypeInfo.insert_llvmins_typeconversions(p: taillvm);
+      var
+        symdef,
+        opdef: tdef;
+        cnv: taillvm;
+        i: longint;
+      begin
+        case p.llvmopcode of
+          la_call:
+            if p.oper[3]^.typ=top_ref then
+              begin
+                symdef:=get_asmsym_def(p.oper[3]^.ref^.symbol);
+                { the type used in the call is different from the type used to
+                  declare the symbol -> insert a typecast }
+                if not equal_llvm_defs(symdef,p.oper[0]^.def) then
+                  begin
+                    if symdef.typ=procdef then
+                      { ugly, but can't use getcopyas(procvardef) due to the
+                        symtablestack not being available here (getpointerdef
+                        is hardcoded to put things in the current module's
+                        symtable) and "pointer to procedure" results in the
+                        correct llvm type }
+                      symdef:=getpointerdef(tprocdef(symdef));
+                    cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,symdef,p.oper[3]^.ref^.symbol,p.oper[0]^.def);
+                    p.loadtai(3,cnv);
+                  end;
+              end;
+          else if p.llvmopcode<>la_br then
+            begin
+              { check the types of all symbolic operands }
+              for i:=0 to p.ops-1 do
+                case p.oper[i]^.typ of
+                  top_ref:
+                    if (p.oper[i]^.ref^.refaddr=addr_full) and
+                       (p.oper[i]^.ref^.symbol.bind<>AB_TEMP) then
+                      begin
+                        symdef:=get_asmsym_def(p.oper[i]^.ref^.symbol);
+                        opdef:=p.spilling_get_reg_type(i);
+                        if not equal_llvm_defs(symdef,opdef) then
+                          begin
+                            cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,symdef,p.oper[i]^.ref^.symbol,opdef);
+                            p.loadtai(i,cnv);
+                          end;
+                      end;
+                  top_tai:
+                    insert_tai_typeconversions(p.oper[i]^.ai);
+                end;
+            end;
+        end;
+      end;
+
+
+    procedure TLLVMTypeInfo.insert_typedconst_typeconversion(p: tai_abstracttypedconst);
+      var
+        symdef: tdef;
+        cnv: taillvm;
+        elementp: tai_abstracttypedconst;
+      begin
+        case p.adetyp of
+          tck_simple:
+            begin
+              case tai_simpletypedconst(p).val.typ of
+                ait_const:
+                  if assigned(tai_const(tai_simpletypedconst(p).val).sym) and
+                     not assigned(tai_const(tai_simpletypedconst(p).val).endsym) then
+                    begin
+                      symdef:=get_asmsym_def(tai_const(tai_simpletypedconst(p).val).sym);
+                      { all references to symbols in typed constants are
+                        references to the address of a global symbol (you can't
+                        refer to the data itself, just like you can't initialise
+                        a Pascal (typed) constant with the contents of another
+                        typed constant) }
+                      symdef:=getpointerdef(symdef);
+                      if not equal_llvm_defs(symdef,p.def) then
+                        begin
+                          cnv:=taillvm.op_reg_tai_size(la_bitcast,NR_NO,tai_simpletypedconst.create(tck_simple,symdef,tai_simpletypedconst(p).val),p.def);
+                          tai_simpletypedconst(p).val:=cnv;
+                        end;
+                    end;
+                else
+                  insert_tai_typeconversions(tai_const(tai_simpletypedconst(p).val));
+              end;
+            end;
+          tck_array,
+          tck_record:
+            begin
+              for elementp in tai_aggregatetypedconst(p) do
+                insert_typedconst_typeconversion(elementp);
+            end;
+        end;
+      end;
+
+
+    procedure TLLVMTypeInfo.insert_tai_typeconversions(p: tai);
+      begin
+        case p.typ of
+          ait_llvmins:
+            insert_llvmins_typeconversions(taillvm(p));
+          { can also be necessary in case someone initialises a typed const with
+            the address of an external symbol aliasing one declared with a
+            different type in the same mmodule. }
+          ait_typedconst:
+            insert_typedconst_typeconversion(tai_abstracttypedconst(p));
+          ait_llvmdecl:
+            insert_asmlist_typeconversions(taillvmdecl(p).initdata);
+        end;
+      end;
+
+
+    procedure TLLVMTypeInfo.insert_asmlist_typeconversions(list: tasmlist);
+      var
+        hp: tai;
+      begin
+        if not assigned(list) then
+          exit;
+        hp:=tai(list.first);
+        while assigned(hp) do
+          begin
+            insert_tai_typeconversions(hp);
             hp:=tai(hp.next);
           end;
       end;
@@ -340,7 +533,11 @@ implementation
         { process all llvm instructions, part of flagging all required tdefs }
         for hal:=low(TasmlistType) to high(TasmlistType) do
           if hal<>al_start then
-            process_asmlist(current_asmdata.asmlists[al_start],current_asmdata.asmlists[hal]);
+            collect_asmlist_info(current_asmdata.asmlists[al_start],current_asmdata.asmlists[hal]);
+
+        for hal:=low(TasmlistType) to high(TasmlistType) do
+          if hal<>al_start then
+            insert_asmlist_typeconversions(current_asmdata.asmlists[hal]);
 
         { write all used defs }
         write_defs_to_write;