* synchronize with trunk

git-svn-id: branches/z80@44519 -

compiler/aasmcnst.pas

@@ -1840,7 +1840,7 @@ implementation
 
    procedure ttai_typedconstbuilder.emit_procdef_const(pd: tprocdef);
      begin
-       emit_tai(Tai_const.Createname(pd.mangledname,AT_FUNCTION,0),cprocvardef.getreusableprocaddr(pd));
+       emit_tai(Tai_const.Createname(pd.mangledname,AT_FUNCTION,0),cprocvardef.getreusableprocaddr(pd,pc_address_only));
      end;
 
 

compiler/arm/narmcnv.pas

@@ -32,27 +32,9 @@ interface
        tarmtypeconvnode = class(tcgtypeconvnode)
          protected
            function first_int_to_real: tnode;override;
-           function first_real_to_real: tnode; override;
+           function first_real_to_real: tnode;override;
-         { procedure second_int_to_int;override; }
-         { procedure second_string_to_string;override; }
-         { procedure second_cstring_to_pchar;override; }
-         { procedure second_string_to_chararray;override; }
-         { procedure second_array_to_pointer;override; }
-         // function first_int_to_real: tnode; override;
-         { procedure second_pointer_to_array;override; }
-         { procedure second_chararray_to_string;override; }
-         { procedure second_char_to_string;override; }
            procedure second_int_to_real;override;
-         // procedure second_real_to_real;override;
-         { procedure second_cord_to_pointer;override; }
-         { procedure second_proc_to_procvar;override; }
-         { procedure second_bool_to_int;override; }
            procedure second_int_to_bool;override;
-         { procedure second_load_smallset;override;  }
-         { procedure second_ansistring_to_pchar;override; }
-         { procedure second_pchar_to_string;override; }
-         { procedure second_class_to_intf;override; }
-         { procedure second_char_to_char;override; }
        end;
 
 implementation

compiler/llvm/hlcgllvm.pas

@@ -567,7 +567,7 @@ implementation
     { if this is a complex procvar, get the non-tmethod-like equivalent }
     if (pd.typ=procvardef) and
        not pd.is_addressonly then
-      pd:=tprocvardef(cprocvardef.getreusableprocaddr(pd));
+      pd:=tprocvardef(cprocvardef.getreusableprocaddr(pd,pc_address_only));
   end;
 
 

compiler/llvm/llvmdef.pas

@@ -48,8 +48,8 @@ interface
      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
+      allows naming struct types) -- only supported for tabstractrecorddef
-      only for tabstractrecorddef descendantds and complex procvars }
+      descendantds and complex procvars }
     function llvmtypeidentifier(def: tdef): TSymStr;
 
     { encode a type into the internal format used by LLVM (for a type
@@ -130,9 +130,10 @@ implementation
 
   function llvmtypeidentifier(def: tdef): TSymStr;
     begin
-      if not assigned(def.typesym) then
+      if assigned(def.typesym) then
-        internalerror(2015041901);
+        result:='%"typ.'+def.fullownerhierarchyname(false)+def.typesym.realname+'"'
-      result:='%"typ.'+def.fullownerhierarchyname(false)+def.typesym.realname+'"'
+      else
+        result:='%"typ.'+def.fullownerhierarchyname(false)+def.unique_id_str+'"';
     end;
 
 
@@ -444,9 +445,7 @@ implementation
           recorddef :
             begin
               { avoid endlessly recursive definitions }
-              if assigned(def.typesym) and
+              if not(lef_typedecl in flags) then
-                 ((lef_inaggregate in flags) or
-                  not(lef_typedecl in flags)) then
                 encodedstr:=encodedstr+llvmtypeidentifier(def)
               else
                 llvmaddencodedabstractrecordtype(trecorddef(def),encodedstr);
@@ -537,9 +536,7 @@ implementation
                   if def.typ=procvardef then
                     encodedstr:=encodedstr+'*';
                 end
-              else if ((lef_inaggregate in flags) or
+              else if not(lef_typedecl in flags) then
-                  not(lef_typedecl in flags)) and
-                 assigned(tprocvardef(def).typesym) then
                 begin
                   { in case the procvardef recursively references itself, e.g.
                     via a pointer }
@@ -569,8 +566,7 @@ implementation
               odt_object,
               odt_cppclass:
                 begin
-                  if not(lef_typedecl in flags) and
+                  if not(lef_typedecl in flags) then
-                     assigned(def.typesym) then
                     encodedstr:=encodedstr+llvmtypeidentifier(def)
                   else
                     llvmaddencodedabstractrecordtype(tabstractrecorddef(def),encodedstr);

compiler/llvm/llvmtype.pas

@@ -574,8 +574,7 @@ implementation
         symdeflist:=tabstractrecordsymtable(def.symtable).llvmst.symdeflist;
         for i:=0 to symdeflist.Count-1 do
           record_def(tllvmshadowsymtableentry(symdeflist[i]).def);
-        if assigned(def.typesym) then
+        list.concat(taillvm.op_size(LA_TYPE,record_def(def)));
-          list.concat(taillvm.op_size(LA_TYPE,record_def(def)));
       end;
 
 
@@ -605,8 +604,7 @@ implementation
         for i:=0 to def.paras.count-1 do
           appenddef(list,llvmgetcgparadef(tparavarsym(def.paras[i]).paraloc[callerside],true,calleeside));
         appenddef(list,llvmgetcgparadef(def.funcretloc[callerside],true,calleeside));
-        if assigned(def.typesym) and
+        if not def.is_addressonly then
-           not def.is_addressonly then
           list.concat(taillvm.op_size(LA_TYPE,record_def(def)));
       end;
 

compiler/llvm/nllvmcnv.pas

@@ -229,7 +229,7 @@ procedure tllvmtypeconvnode.second_proc_to_procvar;
         if location.loc<>LOC_REFERENCE then
           internalerror(2015111902);
         hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,
-          cpointerdef.getreusable(tprocdef(left.resultdef).getcopyas(procvardef,pc_normal,'')),
+          cpointerdef.getreusable(cprocvardef.getreusableprocaddr(tprocdef(left.resultdef),pc_normal)),
           cpointerdef.getreusable(resultdef),
           location.reference);
       end;

compiler/llvm/nllvmld.pas

@@ -92,7 +92,7 @@ procedure tllvmloadnode.pass_generate_code;
             (resultdef.typ in [symconst.procdef,procvardef]) and
              not tabstractprocdef(resultdef).is_addressonly then
             begin
-              pvdef:=tprocvardef(procdef.getcopyas(procvardef,pc_normal,''));
+              pvdef:=cprocvardef.getreusableprocaddr(procdef,pc_normal);
               { on little endian, location.register contains proc and
                 location.registerhi contains self; on big endian, it's the
                 other way around }
@@ -117,7 +117,7 @@ procedure tllvmloadnode.pass_generate_code;
                 selfdef:=cpointerdef.getreusable(left.resultdef);
               mpref:=href;
               hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(pvdef),cpointerdef.getreusable(methodpointertype),mpref);
-              hlcg.g_load_reg_field_by_name(current_asmdata.CurrAsmList,cprocvardef.getreusableprocaddr(procdef),trecorddef(methodpointertype),procreg,'proc',mpref);
+              hlcg.g_load_reg_field_by_name(current_asmdata.CurrAsmList,cprocvardef.getreusableprocaddr(procdef,pc_address_only),trecorddef(methodpointertype),procreg,'proc',mpref);
               hlcg.g_load_reg_field_by_name(current_asmdata.CurrAsmList,selfdef,trecorddef(methodpointertype),selfreg,'self',mpref);
               location_reset_ref(location,LOC_REFERENCE,location.size,href.alignment,href.volatility);
               location.reference:=href;

compiler/llvm/nllvmtcon.pas

@@ -408,7 +408,7 @@ implementation
   procedure tllvmtai_typedconstbuilder.emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef);
     begin
       if not pvdef.is_addressonly then
-        pvdef:=cprocvardef.getreusableprocaddr(pvdef);
+        pvdef:=cprocvardef.getreusableprocaddr(pvdef,pc_address_only);
       emit_tai(p,pvdef);
     end;
 
@@ -731,7 +731,7 @@ implementation
         the procdef }
       if (fromdef.typ=procdef) and
          (todef.typ<>procdef) then
-        fromdef:=cprocvardef.getreusableprocaddr(tprocdef(fromdef));
+        fromdef:=cprocvardef.getreusableprocaddr(tprocdef(fromdef),pc_address_only);
       { typecasting a pointer-sized entity to a complex procvardef -> convert
         to the pointer-component of the complex procvardef (not always, because
         e.g. a tmethod to complex procvar initialises the entire complex
@@ -739,7 +739,7 @@ implementation
       if (todef.typ=procvardef) and
          not tprocvardef(todef).is_addressonly and
          (fromdef.size<todef.size) then
-        todef:=cprocvardef.getreusableprocaddr(tprocvardef(todef));
+        todef:=cprocvardef.getreusableprocaddr(tprocvardef(todef),pc_address_only);
       op:=llvmconvop(fromdef,todef,false);
       case op of
         la_ptrtoint_to_x,

compiler/llvm/nllvmutil.pas

@@ -174,7 +174,7 @@ implementation
         begin
           pd:=tprocdef(procdefs[0]);
           fields[0]:=s32inttype;
-          fields[1]:=pd.getcopyas(procvardef,pc_address_only,'');
+          fields[1]:=cprocvardef.getreusableprocaddr(pd,pc_address_only);
           fields[2]:=voidpointertype;
           itemdef:=llvmgettemprecorddef(fields,C_alignment,
             targetinfos[target_info.system]^.alignment.recordalignmin);

compiler/ncgcal.pas

@@ -501,7 +501,7 @@ implementation
         hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,cpointerdef.getreusable(literaldef),true);
         { load the invoke pointer }
         hlcg.reference_reset_base(href,right.resultdef,right.location.register,0,ctempposinvalid,right.resultdef.alignment,[]);
-        callprocdef:=cprocvardef.getreusableprocaddr(procdefinition);
+        callprocdef:=cprocvardef.getreusableprocaddr(procdefinition,pc_address_only);
         toreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,callprocdef);
         hlcg.g_load_field_reg_by_name(current_asmdata.CurrAsmList,literaldef,callprocdef,'INVOKE',href,toreg);
      end;
@@ -851,7 +851,7 @@ implementation
            of far calls where the procvardef was defined does not matter,
            even though the procvardef constructor called by getcopyas looks at
            it) }
-         callprocdef:=cprocvardef.getreusableprocaddr(procdefinition);
+         callprocdef:=cprocvardef.getreusableprocaddr(procdefinition,pc_address_only);
          reg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,callprocdef);
          { in case we have a method pointer on a big endian target in registers,
            the method address is stored in registerhi (it's the first field

compiler/ncgcnv.pas

@@ -572,7 +572,7 @@ interface
                     begin
                       location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
                       { code field is the first one }
-                      hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(tprocvardef(tprocdef(left.resultdef).getcopyas(procvardef,pc_normal,''))),cpointerdef.getreusable(resultdef),left.location.reference);
+                      hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(cprocvardef.getreusableprocaddr(tprocdef(left.resultdef),pc_normal)),cpointerdef.getreusable(resultdef),left.location.reference);
                       hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,resultdef,resultdef,left.location.reference,location.register);
                     end;
                   LOC_REGISTER,LOC_CREGISTER:

compiler/ncgld.pas

@@ -646,8 +646,8 @@ implementation
                        begin
                          { load address of the function }
                          reference_reset_symbol(href,current_asmdata.RefAsmSymbol(procdef.mangledname,AT_FUNCTION),0,procdef.address_type.alignment,[]);
-                         location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,cprocvardef.getreusableprocaddr(procdef));
+                         location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,cprocvardef.getreusableprocaddr(procdef,pc_address_only));
-                         hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,procdef,cprocvardef.getreusableprocaddr(procdef),href,location.register);
+                         hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,procdef,cprocvardef.getreusableprocaddr(procdef,pc_address_only),href,location.register);
                        end;
 
                      { to get methodpointers stored correctly, code and self register must be swapped on

compiler/ncgrtti.pas

@@ -1385,7 +1385,7 @@ implementation
                     internalerror(201603021)
                   else
                     tcb.emit_tai(Tai_const.Createname(procdef.mangledname,AT_FUNCTION,0),
-                      cprocvardef.getreusableprocaddr(procdef));
+                      cprocvardef.getreusableprocaddr(procdef,pc_address_only));
                 end;
             end;
 

compiler/ncgvmt.pas

@@ -733,7 +733,7 @@ implementation
                 pd:=tprocdef(AImplIntf.procdefs[i]);
                 hs:=CreateWrapperName(_Class,AImplIntf,i,pd);
                 { create reference }
-                datatcb.emit_tai(Tai_const.Createname(hs,AT_FUNCTION,0),cprocvardef.getreusableprocaddr(pd));
+                datatcb.emit_tai(Tai_const.Createname(hs,AT_FUNCTION,0),cprocvardef.getreusableprocaddr(pd,pc_address_only));
               end;
            end
         else
@@ -992,7 +992,7 @@ implementation
                if current_module.moduleid<>vmtpd.owner.moduleid then
                  current_module.addimportedsym(vmtpd.procsym);
              end;
-           tcb.emit_tai(Tai_const.Createname(procname,AT_FUNCTION,0),cprocvardef.getreusableprocaddr(vmtpd));
+           tcb.emit_tai(Tai_const.Createname(procname,AT_FUNCTION,0),cprocvardef.getreusableprocaddr(vmtpd,pc_address_only));
 {$ifdef vtentry}
            hs:='VTENTRY'+'_'+_class.vmt_mangledname+'$$'+tostr(_class.vmtmethodoffset(i) div sizeof(pint));
            current_asmdata.asmlists[al_globals].concat(tai_symbol.CreateName(hs,AT_DATA,0,voidpointerdef));

compiler/ncnv.pas

@@ -2339,7 +2339,7 @@ implementation
              copytype:=pc_address_only
            else
              copytype:=pc_normal;
-           resultdef:=pd.getcopyas(procvardef,copytype,'');
+           resultdef:=cprocvardef.getreusableprocaddr(pd,copytype);
          end;
       end;
 

compiler/ngtcon.pas

@@ -1456,7 +1456,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         { get the address of the procedure, except if it's a C-block (then we
           we will end up with a record that represents the C-block) }
         if not is_block(def) then
-          procaddrdef:=cprocvardef.getreusableprocaddr(def)
+          procaddrdef:=cprocvardef.getreusableprocaddr(def,pc_address_only)
         else
           procaddrdef:=def;
         ftcb.queue_init(procaddrdef);

compiler/nobj.pas

@@ -889,7 +889,7 @@ implementation
         { now add the methods }
         for i:=0 to _class.vmtentries.count-1 do
           vmtdef.add_field_by_def('',
-            cprocvardef.getreusableprocaddr(pvmtentry(_class.vmtentries[i])^.procdef)
+            cprocvardef.getreusableprocaddr(pvmtentry(_class.vmtentries[i])^.procdef,pc_address_only)
           );
         { the VMT ends with a nil pointer }
         vmtdef.add_field_by_def('',voidcodepointertype);

compiler/psystem.pas

@@ -243,7 +243,9 @@ implementation
               s64floattype:=cfloatdef.create(s64real,true);
               s80floattype:=cfloatdef.create(s80real,true);
               sc80floattype:=cfloatdef.create(sc80real,true);
-            end else begin
+            end
+          else
+            begin
               s32floattype:=nil;
               s64floattype:=nil;
               s80floattype:=nil;

compiler/symdef.pas

@@ -640,15 +640,16 @@ interface
          pno_mangledname, pno_noparams);
        tprocnameoptions = set of tprocnameoption;
        tproccopytyp = (pc_normal,
+                       { creates a procvardef describing only the code pointer
+                         of a method/netsted function/... }
+                       pc_address_only,
                        { everything except for hidden parameters }
                        pc_normal_no_hidden,
                        { always creates a top-level function, removes all
                          special parameters (self, vmt, parentfp, ...) }
-                       pc_bareproc,
+                       pc_bareproc
-                       { creates a procvardef describing only the code pointer
-                         of a method/netsted function/... }
-                       pc_address_only
                        );
+       tcacheableproccopytyp = pc_normal..pc_address_only;
 
        tabstractprocdef = class(tstoreddef)
           { saves a definition to the return type }
@@ -703,7 +704,7 @@ interface
        tprocvardef = class(tabstractprocdef)
           constructor create(level:byte);virtual;
           { returns a procvardef that represents the address of a proc(var)def }
-          class function getreusableprocaddr(def: tabstractprocdef): tprocvardef; virtual;
+          class function getreusableprocaddr(def: tabstractprocdef; copytyp: tcacheableproccopytyp): tprocvardef; virtual;
           { same as above, but in case the def must never be freed after the
             current module has been compiled -- even if the def was not written
             to the ppu file (for defs in para locations, as we don't reset them
@@ -6958,14 +6959,21 @@ implementation
       end;
 
 
-    class function tprocvardef.getreusableprocaddr(def: tabstractprocdef): tprocvardef;
+    class function tprocvardef.getreusableprocaddr(def: tabstractprocdef; copytyp: tcacheableproccopytyp): tprocvardef;
       var
         res: PHashSetItem;
         oldsymtablestack: tsymtablestack;
+        key: packed record
+          def: tabstractprocdef;
+          copytyp: tcacheableproccopytyp;
+        end;
+
       begin
         if not assigned(current_module) then
           internalerror(2011081301);
-        res:=current_module.procaddrdefs.FindOrAdd(@def,sizeof(def));
+        key.def:=def;
+        key.copytyp:=copytyp;
+        res:=current_module.procaddrdefs.FindOrAdd(@key,sizeof(key));
         if not assigned(res^.Data) then
           begin
             { since these pointerdefs can be reused anywhere in the current
@@ -6977,7 +6985,7 @@ implementation
             { do not simply push/pop current_module.localsymtable, because
               that can have side-effects (e.g., it removes helpers) }
             symtablestack:=nil;
-            result:=tprocvardef(def.getcopyas(procvardef,pc_address_only,''));
+            result:=tprocvardef(def.getcopyas(procvardef,copytyp,''));
             setup_reusable_def(def,result,res,oldsymtablestack);
             { res^.Data may still be nil -> don't overwrite result }
             exit;
@@ -6988,7 +6996,7 @@ implementation
 
     class function tprocvardef.getreusableprocaddr_no_free(def: tabstractprocdef): tprocvardef;
       begin
-        result:=getreusableprocaddr(def);
+        result:=getreusableprocaddr(def,pc_address_only);
         if not result.is_registered then
           include(result.defoptions,df_not_registered_no_free);
       end;