* synchronised with trunk till r42105

git-svn-id: branches/debug_eh@42106 -

compiler/llvm/llvmdef.pas

@@ -68,7 +68,7 @@ interface
       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: array of tdef; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;
+    function llvmgettemprecorddef(const fieldtypes: array of tdef; 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
@@ -862,7 +862,7 @@ implementation
       end;
 
 
-    function llvmgettemprecorddef(fieldtypes: array of tdef; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;
+    function llvmgettemprecorddef(const fieldtypes: array of tdef; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;
       var
         i: longint;
         res: PHashSetItem;

compiler/ncgld.pas

@@ -557,7 +557,8 @@ implementation
                        hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
                      { vd will contain the type of the self pointer (self in
                        case of a class/classref, address of self in case of
-                       an object }
+                       an object, frame pointer or pointer to parentfpstruct
+                       in case of nested procsym load  }
                      vd:=nil;
                      case left.location.loc of
                         LOC_CREGISTER,
@@ -573,7 +574,8 @@ implementation
                         LOC_REFERENCE:
                           begin
                              if is_implicit_pointer_object_type(left.resultdef) or
-                                 (left.resultdef.typ=classrefdef) then
+                                (left.resultdef.typ=classrefdef) or
+                                is_nested_pd(procdef) then
                                begin
                                  vd:=left.resultdef;
                                  location.registerhi:=hlcg.getaddressregister(current_asmdata.CurrAsmList,left.resultdef);

compiler/ngenutil.pas

@@ -143,6 +143,9 @@ interface
         also for the linker }
       class procedure RegisterUsedAsmSym(sym: TAsmSymbol; def: tdef; compileronly: boolean); virtual;
 
+      class procedure RegisterModuleInitFunction(pd: tprocdef); virtual;
+      class procedure RegisterModuleFiniFunction(pd: tprocdef); virtual;
+
       class procedure GenerateObjCImageInfo; virtual;
 
      strict protected
@@ -163,7 +166,8 @@ implementation
       symbase,symtable,defutil,
       nadd,ncal,ncnv,ncon,nflw,ninl,nld,nmem,nutils,
       ppu,
-      pass_1;
+      pass_1,
+      export;
 
   class function tnodeutils.call_fail_node:tnode;
     var
@@ -949,7 +953,7 @@ implementation
       { the mainstub is generated via a synthetic proc -> parsed via
         psub.read_proc_body() -> that one will insert the mangled name in the
         alias names already }
-      if potype<>potype_mainstub then
+      if not(potype in [potype_mainstub,potype_libmainstub]) then
         pd.aliasnames.insert(pd.mangledname);
       result:=pd;
     end;
@@ -1564,6 +1568,20 @@ implementation
     end;
 
 
+  class procedure tnodeutils.RegisterModuleInitFunction(pd: tprocdef);
+    begin
+      { setinitname may generate a new section -> don't add to the
+        current list, because we assume this remains a text section }
+      exportlib.setinitname(current_asmdata.AsmLists[al_pure_assembler],pd.mangledname);
+    end;
+
+
+  class procedure tnodeutils.RegisterModuleFiniFunction(pd: tprocdef);
+    begin
+      exportlib.setfininame(current_asmdata.AsmLists[al_pure_assembler],pd.mangledname);
+    end;
+
+
   class procedure tnodeutils.GenerateObjCImageInfo;
     var
       tcb: ttai_typedconstbuilder;

compiler/pexpr.pas

@@ -1150,7 +1150,7 @@ implementation
                  hp2:=cloadnode.create_procvar(tprocsym(tcallnode(hp).symtableprocentry),currprocdef,tcallnode(hp).symtableproc);
                  if (po_methodpointer in pv.procoptions) then
                    tloadnode(hp2).set_mp(tcallnode(hp).methodpointer.getcopy);
-                 hp.destroy;
+                 hp.free;
                  { replace the old callnode with the new loadnode }
                  hpp^:=hp2;
                end;

compiler/pmodules.pas

@@ -670,7 +670,7 @@ implementation
         st.insert(ps);
         pd:=tprocdef(cnodeutils.create_main_procdef(target_info.cprefix+name,potype,ps));
         { We don't need a local symtable, change it into the static symtable }
-        if not (potype in [potype_mainstub,potype_pkgstub]) then
+        if not (potype in [potype_mainstub,potype_pkgstub,potype_libmainstub]) then
           begin
             pd.localst.free;
             pd.localst:=st;
@@ -1903,13 +1903,13 @@ type
       var
          main_file : tinputfile;
          hp,hp2    : tmodule;
+         initpd    : tprocdef;
          finalize_procinfo,
          init_procinfo,
          main_procinfo : tcgprocinfo;
          force_init_final : boolean;
          resources_used : boolean;
          program_uses_checkpointer : boolean;
-         initname,
          program_name : ansistring;
          consume_semicolon_after_uses : boolean;
          ps : tprogramparasym;
@@ -2129,6 +2129,17 @@ type
            from the bootstrap code.}
          if islibrary then
           begin
+            initpd:=nil;
+            { ToDo: other systems that use indirect entry info, but check back with Windows! }
+            { we need to call FPC_LIBMAIN in sysinit which in turn will call PascalMain -> create dummy stub }
+            if target_info.system in systems_darwin then
+              begin
+                main_procinfo:=create_main_proc(make_mangledname('sysinitcallthrough',current_module.localsymtable,'stub'),potype_libmainstub,current_module.localsymtable);
+                call_through_new_name(main_procinfo.procdef,target_info.cprefix+'FPC_LIBMAIN');
+                initpd:=main_procinfo.procdef;
+                main_procinfo.free;
+              end;
+
             main_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,current_module.localsymtable);
             { Win32 startup code needs a single name }
             if not(target_info.system in (systems_darwin+systems_aix)) then
@@ -2136,17 +2147,10 @@ type
             else
               main_procinfo.procdef.aliasnames.concat(target_info.Cprefix+'PASCALMAIN');
 
-            { ToDo: systems that use indirect entry info, but check back with Windows! }
-            if target_info.system in systems_darwin then
-              { we need to call FPC_LIBMAIN in sysinit which in turn will call PascalMain }
-              initname:=target_info.cprefix+'FPC_LIBMAIN'
-            else
-              initname:=main_procinfo.procdef.mangledname;
-            { setinitname may generate a new section -> don't add to the
-              current list, because we assume this remains a text section
-              -- add to pure assembler section, so in case of special directives
-                they are directly added to the assembler output by llvm }
-            exportlib.setinitname(current_asmdata.AsmLists[al_pure_assembler],initname);
+            if not(target_info.system in systems_darwin) then
+              initpd:=main_procinfo.procdef;
+
+            cnodeutils.RegisterModuleInitFunction(initpd);
           end
          else if (target_info.system in ([system_i386_netware,system_i386_netwlibc,system_powerpc_macos]+systems_darwin+systems_aix)) then
            begin
@@ -2225,7 +2229,7 @@ type
           { Place in "pure assembler" list so that the llvm assembler writer
             directly emits the generated directives }
           if (islibrary) then
-            exportlib.setfininame(current_asmdata.asmlists[al_pure_assembler],'FPC_LIB_EXIT');
+            cnodeutils.RegisterModuleFiniFunction(search_system_proc('fpc_lib_exit'));
 
          { all labels must be defined before generating code }
          if Errorcount=0 then

compiler/symconst.pas

@@ -308,7 +308,8 @@ type
     potype_propsetter,
     potype_exceptfilter,      { SEH exception filter or termination handler }
     potype_mainstub,          { "main" function that calls through to FPC_SYSTEMMAIN }
-    potype_pkgstub            { stub for a package file, that tells OS that all is OK }
+    potype_pkgstub,           { stub for a package file, that tells OS that all is OK }
+    potype_libmainstub        { "main" function for a library that calls through to FPC_LIBMAIN }
   );
   tproctypeoptions=set of tproctypeoption;
 
@@ -968,7 +969,8 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
       'property setters',   {potype_propsetter}
       'exception filters',  {potype_exceptfilter}
       '"main" stub',        {potype_mainstub}
-      'package stub'        {potype_pkgstub}
+      'package stub',       {potype_pkgstub}
+      'lib "main" stub'     {potype_libmainstub}
     );
 
     { TProcOption string identifiers for error messages }

compiler/utils/ppuutils/ppudump.pp

@@ -1950,7 +1950,8 @@ const
      (mask:potype_propsetter;        str:'Property Setter'),
      (mask:potype_exceptfilter;      str:'SEH filter'),
      (mask:potype_mainstub;          str:'main stub'),
-     (mask:potype_pkgstub;           str:'package stub')
+     (mask:potype_pkgstub;           str:'package stub'),
+     (mask:potype_libmainstub;       str:'library main stub')
   );
   procopt : array[1..ord(high(tprocoption))] of tprocopt=(
      (mask:po_classmethod;     str:'ClassMethod'),

rtl/inc/compproc.inc

@@ -787,9 +787,9 @@ procedure fpc_do_exit;compilerproc;
 
 {
 Procedure fpc_do_exit; compilerproc;
-Procedure fpc_lib_exit; compilerproc;
 Procedure fpc_HandleErrorAddrFrame (Errno : longint;addr,frame : pointer); compilerproc;
 }
+Procedure fpc_lib_exit; compilerproc;
 Procedure fpc_HandleError (Errno : longint); compilerproc;
 
 procedure fpc_AbstractErrorIntern;compilerproc;

rtl/inc/system.inc

@@ -1135,7 +1135,7 @@ end;
 procedure internal_do_exit; external name 'FPC_DO_EXIT';
 
 
-Procedure lib_exit;[Public,Alias:'FPC_LIB_EXIT'];
+Procedure fpc_lib_exit;[Public,Alias:'FPC_LIB_EXIT'];
 begin
   InternalExit;
 end;

tests/tbs/tb0508.pp

@@ -1,5 +1,7 @@
 { inlining is not compatible with get_caller_frame/get_frame }
 {$inline off}
+
+{$ifndef cpullvm}
 type
   PointerLocal = procedure(_EBP: Pointer);
 
@@ -44,3 +46,8 @@ var
 begin
   t1;
 end.
+{$else ndef cpullvm}
+begin
+  { this kind of hacks can never work on llvm }
+end.
+{$endif cpullvm}

tests/test/opt/tdfa19.pp

@@ -1,5 +1,5 @@
 { %OPT=-Oodfa -vw -Sew }
-{ %norun }
+{ %norun }
 
 {$mode objfpc}
 

tests/webtbs/tw17379.pp

@@ -1,22 +1,34 @@
-{ %norun }
-
 {$mode macpas}
 {$warnings off}
 program recursivefunctionparam;
 
 function first( function test( theint: integer): boolean): integer;
-begin {not implemented} end;
+begin
+  test(2);
+end;
 
 function find: integer;
+  var
+    l: longint;
 
   function test( theint: integer): boolean;
   begin
-    first( test)
+    if (theint = 1) then
+      first( test)
+    else
+      begin
+        writeln('nested procvar call, l = ', l);
+        if l<>1234567890 then
+          halt(1);
+      end;
+    find:=0;
   end;
 
 begin
-  {not implemented}
+  l:=1234567890;
+  test(1)
 end;
 
 begin
+  find;
 end.