+ introduce a new potype for the main stub of a package library (which on Windows is simply a DLLMain returning True)

git-svn-id: trunk@35371 -

compiler/ngenutil.pas

@@ -133,7 +133,7 @@ implementation
 
     uses
       verbose,version,globals,cutils,constexp,
-      scanner,systems,procinfo,fmodule,
+      scanner,systems,procinfo,fmodule,pparautl,
       aasmbase,aasmtai,aasmcnst,
       symbase,symtable,defutil,symcreat,
       nadd,ncal,ncnv,ncon,nflw,ninl,nld,nmem,nobj,nutils,ncgutil,
@@ -1467,6 +1467,20 @@ implementation
            pvs:=cparavarsym.create('ARGP',3,vs_const,cpointerdef.getreusable(charpointertype),[]);
            tprocdef(pd).parast.insert(pvs);
            tprocdef(pd).calcparas;
+         end
+       { package stub for Windows is a DLLMain }
+       else if (tprocdef(pd).proctypeoption=potype_pkgstub) and
+           (target_info.system in systems_all_windows+systems_nativent) then
+         begin
+           pvs:=cparavarsym.create('HINSTANCE',1,vs_const,uinttype,[]);
+           tprocdef(pd).parast.insert(pvs);
+           pvs:=cparavarsym.create('DLLREASON',2,vs_const,u32inttype,[]);
+           tprocdef(pd).parast.insert(pvs);
+           pvs:=cparavarsym.create('DLLPARAM',3,vs_const,voidpointertype,[]);
+           tprocdef(pd).parast.insert(pvs);
+           tprocdef(pd).returndef:=bool32type;
+           insert_funcret_para(tprocdef(pd));
+           tprocdef(pd).calcparas;
          end;
      end;
 

compiler/pmodules.pas

@@ -633,11 +633,14 @@ implementation
         pd:=tprocdef(cnodeutils.create_main_procdef(target_info.cprefix+name,potype,ps));
         { We don't need is a local symtable. Change it into the static
           symtable }
-        if potype<>potype_mainstub then
+        if not (potype in [potype_mainstub,potype_pkgstub]) then
           begin
             pd.localst.free;
             pd.localst:=st;
           end
+        else if (potype=potype_pkgstub) and
+            (target_info.system in systems_all_windows+systems_nativent) then
+          pd.proccalloption:=pocall_stdcall
         else
           pd.proccalloption:=pocall_cdecl;
         handle_calling_convention(pd);
@@ -645,7 +648,8 @@ implementation
         result:=tcgprocinfo(cprocinfo.create(nil));
         result.procdef:=pd;
         { main proc does always a call e.g. to init system unit }
-        include(result.flags,pi_do_call);
+        if potype<>potype_pkgstub then
+          include(result.flags,pi_do_call);
       end;
 
 

compiler/symconst.pas

@@ -304,7 +304,8 @@ type
     potype_propgetter,        { Dispinterface property accessors }
     potype_propsetter,
     potype_exceptfilter,      { SEH exception filter or termination handler }
-    potype_mainstub           { "main" function that calls through to FPC_SYSTEMMAIN }
+    potype_mainstub,          { "main" function that calls through to FPC_SYSTEMMAIN }
+    potype_pkgstub            { stub for a package file, that tells OS that all is OK }
   );
   tproctypeoptions=set of tproctypeoption;
 

compiler/symcreat.pas

@@ -29,7 +29,8 @@ interface
   uses
     finput,tokens,scanner,globtype,
     aasmdata,
-    symconst,symbase,symtype,symdef,symsym;
+    symconst,symbase,symtype,symdef,symsym,
+    node;
 
 
   type
@@ -128,17 +129,18 @@ interface
     to this new procedure }
   procedure call_through_new_name(orgpd: tprocdef; const newname: TSymStr);
 
+  function generate_pkg_stub(pd:tprocdef):tnode;
 
 implementation
 
   uses
-    cutils,cclasses,globals,verbose,systems,comphook,fmodule,
+    cutils,cclasses,globals,verbose,systems,comphook,fmodule,constexp,
     symtable,defutil,
     pbase,pdecobj,pdecsub,psub,ptconst,pparautl,
 {$ifdef jvm}
     pjvm,jvmdef,
 {$endif jvm}
-    node,nbas,nld,nmem,ngenutil,
+    nbas,nld,nmem,ngenutil,ncon,
     defcmp,
     paramgr;
 
@@ -1479,5 +1481,21 @@ implementation
       orgpd.forwarddef:=true;
     end;
 
+
+  function generate_pkg_stub(pd:tprocdef):tnode;
+    begin
+      if target_info.system in systems_all_windows+systems_nativent then
+        begin
+          insert_funcret_local(pd);
+          result:=cassignmentnode.create(
+                      cloadnode.create(pd.funcretsym,pd.localst),
+                      cordconstnode.create(1,bool32type,false)
+                    );
+        end
+      else
+        result:=cnothingnode.create;
+    end;
+
+
 end.
 

compiler/utils/ppuutils/ppudump.pp

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