Browse Source

* emit the correct declaration for procdefs used to force a procname in LLVM
o fixes lazarus startup on macOS/AArch64 when compiled with the LLVM cg

git-svn-id: trunk@46675 -

Jonas Maebe 5 năm trước cách đây
mục cha
commit
453bfcd370

+ 2 - 2
compiler/jvm/njvmcal.pas

@@ -600,10 +600,10 @@ implementation
           result:=inherited pass_1;
           result:=inherited pass_1;
           if assigned(result) then
           if assigned(result) then
             exit;
             exit;
-          { set fforcedprocname so that even virtual method calls will be
+          { set foverrideprocnamedef so that even virtual method calls will be
             name-based (instead of based on VMT entry numbers) }
             name-based (instead of based on VMT entry numbers) }
           if procdefinition.typ=procdef then
           if procdefinition.typ=procdef then
-            fforcedprocname:=tprocdef(procdefinition).mangledname
+            foverrideprocnamedef:=tprocdef(procdefinition)
         end;
         end;
     end;
     end;
 
 

+ 26 - 0
compiler/llvm/nllvmcal.pas

@@ -39,6 +39,7 @@ interface
         function paraneedsinlinetemp(para: tcallparanode; const pushconstaddr, complexpara: boolean): boolean; override;
         function paraneedsinlinetemp(para: tcallparanode; const pushconstaddr, complexpara: boolean): boolean; override;
         function can_call_ref(var ref: treference): boolean; override;
         function can_call_ref(var ref: treference): boolean; override;
         procedure pushparas; override;
         procedure pushparas; override;
+        procedure pass_generate_code; override;
       end;
       end;
 
 
 
 
@@ -46,6 +47,7 @@ implementation
 
 
      uses
      uses
        verbose,
        verbose,
+       aasmbase,aasmdata,aasmllvm,
        symconst,symdef;
        symconst,symdef;
 
 
 {*****************************************************************************
 {*****************************************************************************
@@ -104,6 +106,30 @@ implementation
          end;
          end;
       end;
       end;
 
 
+
+    procedure tllvmcallnode.pass_generate_code;
+      var
+        asmsym: tasmsymbol;
+      begin
+        inherited;
+        if assigned(overrideprocnamedef) and
+           not overrideprocnamedef.in_currentunit then
+          begin
+            { insert an llvm declaration for this def if it's not defined in
+              the current unit, because otherwise we will define it in the
+              LLVM IR using the def for which this procdef's name is used
+              first, which may be something completely different from the original
+              def. LLVM can take the original def into account to load certain
+              registers, so if we use a wrong def this can result in wrong code
+              generation. }
+           asmsym:=current_asmdata.RefAsmSymbol(overrideprocnamedef.mangledname,AT_FUNCTION);
+           if not asmsym.declared then
+             begin
+               current_asmdata.AsmLists[al_imports].Concat(taillvmdecl.createdecl(asmsym,overrideprocnamedef,nil,sec_code,overrideprocnamedef.alignment));
+             end;
+          end;
+      end;
+
 begin
 begin
   ccallnode:=tllvmcallnode;
   ccallnode:=tllvmcallnode;
 end.
 end.

+ 9 - 33
compiler/ncal.pas

@@ -67,7 +67,7 @@ interface
        private
        private
           { number of parameters passed from the source, this does not include the hidden parameters }
           { number of parameters passed from the source, this does not include the hidden parameters }
           paralength   : smallint;
           paralength   : smallint;
-          function getforcedprocname: TSymStr;
+          function getoverrideprocnamedef: tprocdef; inline;
           function  is_simple_para_load(p:tnode; may_be_in_reg: boolean):boolean;
           function  is_simple_para_load(p:tnode; may_be_in_reg: boolean):boolean;
           procedure maybe_load_in_temp(var p:tnode);
           procedure maybe_load_in_temp(var p:tnode);
           function  gen_high_tree(var p:tnode;paradef:tdef):tnode;
           function  gen_high_tree(var p:tnode;paradef:tdef):tnode;
@@ -90,6 +90,7 @@ interface
           function  pass1_normal:tnode;
           function  pass1_normal:tnode;
           procedure register_created_object_types;
           procedure register_created_object_types;
           function get_expect_loc: tcgloc;
           function get_expect_loc: tcgloc;
+
        protected
        protected
           function safe_call_self_node: tnode;
           function safe_call_self_node: tnode;
           procedure load_in_temp(var p:tnode);
           procedure load_in_temp(var p:tnode);
@@ -124,12 +125,8 @@ interface
             to ppu, is set while processing the node). Also used on the JVM
             to ppu, is set while processing the node). Also used on the JVM
             target for calling virtual methods, as this is name-based and not
             target for calling virtual methods, as this is name-based and not
             based on VMT entry locations }
             based on VMT entry locations }
-{$ifdef symansistr}
-          fforcedprocname: TSymStr;
-{$else symansistr}
-          fforcedprocname: pshortstring;
-{$endif symansistr}
-          property forcedprocname: TSymStr read getforcedprocname;
+          foverrideprocnamedef: tprocdef;
+          property overrideprocnamedef: tprocdef read getoverrideprocnamedef;
        public
        public
           { the symbol containing the definition of the procedure }
           { the symbol containing the definition of the procedure }
           { to call                                               }
           { to call                                               }
@@ -1656,9 +1653,6 @@ implementation
          call_vmt_node.free;
          call_vmt_node.free;
          vmt_entry.free;
          vmt_entry.free;
          spezcontext.free;
          spezcontext.free;
-{$ifndef symansistr}
-         stringdispose(fforcedprocname);
-{$endif symansistr}
          inherited destroy;
          inherited destroy;
       end;
       end;
 
 
@@ -1844,14 +1838,7 @@ implementation
          end
          end
         else
         else
          n.varargsparas:=nil;
          n.varargsparas:=nil;
-{$ifdef symansistr}
-        n.fforcedprocname:=fforcedprocname;
-{$else symansistr}
-        if assigned(fforcedprocname) then
-          n.fforcedprocname:=stringdup(fforcedprocname^)
-        else
-          n.fforcedprocname:=nil;
-{$endif symansistr}
+        n.foverrideprocnamedef:=foverrideprocnamedef;
         result:=n;
         result:=n;
       end;
       end;
 
 
@@ -2084,16 +2071,9 @@ implementation
       end;
       end;
 
 
 
 
-    function tcallnode.getforcedprocname: TSymStr;
+    function tcallnode.getoverrideprocnamedef: tprocdef; inline;
       begin
       begin
-{$ifdef symansistr}
-        result:=fforcedprocname;
-{$else}
-        if assigned(fforcedprocname) then
-          result:=fforcedprocname^
-        else
-          result:='';
-{$endif}
+        result:=foverrideprocnamedef;
       end;
       end;
 
 
 
 
@@ -2670,7 +2650,7 @@ implementation
         vmt_def: trecorddef;
         vmt_def: trecorddef;
       begin
       begin
         if not assigned(right) and
         if not assigned(right) and
-           (forcedprocname='') and
+           not assigned(overrideprocnamedef) and
            (po_virtualmethod in procdefinition.procoptions) and
            (po_virtualmethod in procdefinition.procoptions) and
            not is_objectpascal_helper(tprocdef(procdefinition).struct) and
            not is_objectpascal_helper(tprocdef(procdefinition).struct) and
            assigned(methodpointer) and
            assigned(methodpointer) and
@@ -2780,11 +2760,7 @@ implementation
            (srsym.typ<>procsym) or
            (srsym.typ<>procsym) or
            (tprocsym(srsym).ProcdefList.count<>1) then
            (tprocsym(srsym).ProcdefList.count<>1) then
           Message1(cg_f_unknown_compilerproc,'objc.'+msgsendname);
           Message1(cg_f_unknown_compilerproc,'objc.'+msgsendname);
-{$ifdef symansistr}
-        fforcedprocname:=tprocdef(tprocsym(srsym).ProcdefList[0]).mangledname;
-{$else symansistr}
-        fforcedprocname:=stringdup(tprocdef(tprocsym(srsym).ProcdefList[0]).mangledname);
-{$endif symansistr}
+        foverrideprocnamedef:=tprocdef(tprocsym(srsym).ProcdefList[0]);
 
 
         { B) Handle self }
         { B) Handle self }
         { 1) in case of sending a message to a superclass, self is a pointer to
         { 1) in case of sending a message to a superclass, self is a pointer to

+ 9 - 4
compiler/ncgcal.pas

@@ -1067,10 +1067,10 @@ implementation
                end;
                end;
 {$endif vtentry}
 {$endif vtentry}
 
 
-             name_to_call:=forcedprocname;
              { When methodpointer is typen we don't need (and can't) load
              { When methodpointer is typen we don't need (and can't) load
                a pointer. We can directly call the correct procdef (PFV) }
                a pointer. We can directly call the correct procdef (PFV) }
-             if (name_to_call='') and
+             name_to_call:='';
+             if not assigned(overrideprocnamedef) and
                 (po_virtualmethod in procdefinition.procoptions) and
                 (po_virtualmethod in procdefinition.procoptions) and
                 not is_objectpascal_helper(tprocdef(procdefinition).struct) and
                 not is_objectpascal_helper(tprocdef(procdefinition).struct) and
                 assigned(methodpointer) and
                 assigned(methodpointer) and
@@ -1164,8 +1164,13 @@ implementation
                         extra_interrupt_code;
                         extra_interrupt_code;
                       extra_call_code;
                       extra_call_code;
                       retloc.resetiftemp;
                       retloc.resetiftemp;
-                      if (name_to_call='') then
-                        name_to_call:=tprocdef(procdefinition).mangledname;
+                      if name_to_call='' then
+                        begin
+                          if not assigned(overrideprocnamedef) then
+                            name_to_call:=tprocdef(procdefinition).mangledname
+                          else
+                            name_to_call:=overrideprocnamedef.mangledname;
+                        end;
                       if cnf_inherited in callnodeflags then
                       if cnf_inherited in callnodeflags then
                         retloc:=hlcg.a_call_name_inherited(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,paralocs)
                         retloc:=hlcg.a_call_name_inherited(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,paralocs)
                       { under certain conditions, a static call (i.e. without PIC) can be generated }
                       { under certain conditions, a static call (i.e. without PIC) can be generated }