+ inlined procedures inherit procinfo flags

compiler/ncal.pas

@@ -2465,8 +2465,8 @@ type
                      CGMessage(cg_e_unable_inline_procvar);
                    if not assigned(inlinecode) then
                      begin
-                       if assigned(tprocdef(procdefinition).code) then
-                         inlinecode:=tprocdef(procdefinition).code.getcopy
+                       if assigned(tprocdef(procdefinition).inlininginfo^.code) then
+                         inlinecode:=tprocdef(procdefinition).inlininginfo^.code.getcopy
                        else
                          CGMessage(cg_e_no_code_for_inline_stored);
                        if assigned(inlinecode) then
@@ -2612,7 +2612,10 @@ type
            end;
       errorexit:
          if assigned(inlinecode) then
-           procdefinition.proccalloption:=pocall_inline;
+           begin
+             procdefinition.proccalloption:=pocall_inline;
+             current_procinfo.flags:=current_procinfo.flags+((procdefinition as tprocdef).inlininginfo^.flags*inherited_inlining_flags);
+           end;
       end;
 
 {$ifdef state_tracking}
@@ -2698,7 +2701,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.212  2003-12-08 22:37:28  peter
+  Revision 1.213  2003-12-16 21:29:24  florian
+    + inlined procedures inherit procinfo flags
+
+  Revision 1.212  2003/12/08 22:37:28  peter
     * paralength is private again
 
   Revision 1.211  2003/12/08 16:34:23  peter

compiler/nopt.pas

@@ -86,7 +86,7 @@ var
 implementation
 
 uses cutils, htypechk, defutil, defcmp, globtype, globals, cpubase, ncnv, ncon,ncal,
-     verbose, symdef, cgbase, procinfo;
+     verbose, symconst,symdef, cgbase, procinfo;
 
 
 {*****************************************************************************
@@ -290,7 +290,10 @@ end.
 
 {
   $Log$
-  Revision 1.17  2003-10-01 20:34:49  peter
+  Revision 1.18  2003-12-16 21:29:24  florian
+    + inlined procedures inherit procinfo flags
+
+  Revision 1.17  2003/10/01 20:34:49  peter
     * procinfo unit contains tprocinfo
     * cginfo renamed to cgbase
     * moved cgmessage to verbose

compiler/procinfo.pas

@@ -38,21 +38,9 @@ unit procinfo;
       aasmbase,aasmtai
       ;
 
+    const
+      inherited_inlining_flags : tprocinfoflags = [pi_do_call];
 
-    type
-      tprocinfoflag=(
-        {# procedure uses asm }
-        pi_uses_asm,
-        {# procedure does a call }
-        pi_do_call,
-        {# procedure has a try statement = no register optimization }
-        pi_uses_exceptions,
-        {# procedure is declared as @var(assembler), don't optimize}
-        pi_is_assembler,
-        {# procedure contains data which needs to be finalized }
-        pi_needs_implicit_finally
-      );
-      tprocinfoflags=set of tprocinfoflag;
 
     type
        {# This object gives information on the current routine being
@@ -211,7 +199,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.9  2003-12-03 23:13:20  peter
+  Revision 1.10  2003-12-16 21:29:24  florian
+    + inlined procedures inherit procinfo flags
+
+  Revision 1.9  2003/12/03 23:13:20  peter
     * delayed paraloc allocation, a_param_*() gets extra parameter
       if it needs to allocate temp or real paralocation
     * optimized/simplified int-real loading

compiler/psub.pas

@@ -249,7 +249,7 @@ implementation
         writeln(printnodefile,'*******************************************************************************');
         writeln(printnodefile,current_procinfo.procdef.fullprocname(false));
         writeln(printnodefile,'*******************************************************************************');
-        printnode(printnodefile,pd.code);
+        printnode(printnodefile,pd.inlininginfo^.code);
         close(printnodefile);
       end;
 
@@ -895,7 +895,7 @@ implementation
             code.free;
             code:=nil;
             if (procdef.proccalloption<>pocall_inline) then
-              procdef.code:=nil;
+              procdef.inlininginfo^.code:=nil;
           end;
        end;
 
@@ -985,13 +985,14 @@ implementation
                printnode_procdef(procdef);
            end;
 
+         new(procdef.inlininginfo);
          { store a copy of the original tree for inline, for
            normal procedures only store a reference to the
            current tree }
          if (procdef.proccalloption=pocall_inline) then
-           procdef.code:=code.getcopy
+           procdef.inlininginfo^.code:=code.getcopy
          else
-           procdef.code:=code;
+           procdef.inlininginfo^.code:=code;
 
          { ... remove symbol tables }
          remove_from_symtablestack;
@@ -1330,7 +1331,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.177  2003-12-15 21:25:48  peter
+  Revision 1.178  2003-12-16 21:29:24  florian
+    + inlined procedures inherit procinfo flags
+
+  Revision 1.177  2003/12/15 21:25:48  peter
     * reg allocations for imaginary register are now inserted just
       before reg allocation
     * tregister changed to enum to allow compile time check

compiler/symconst.pas

@@ -319,6 +319,20 @@ type
     te_exact
   );
 
+  tprocinfoflag=(
+    {# procedure uses asm }
+    pi_uses_asm,
+    {# procedure does a call }
+    pi_do_call,
+    {# procedure has a try statement = no register optimization }
+    pi_uses_exceptions,
+    {# procedure is declared as @var(assembler), don't optimize}
+    pi_is_assembler,
+    {# procedure contains data which needs to be finalized }
+    pi_needs_implicit_finally
+  );
+  tprocinfoflags=set of tprocinfoflag;
+
 {$ifdef GDB}
 type
   tdefstabstatus = (
@@ -379,7 +393,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.71  2003-11-23 17:05:16  peter
+  Revision 1.72  2003-12-16 21:29:24  florian
+    + inlined procedures inherit procinfo flags
+
+  Revision 1.71  2003/11/23 17:05:16  peter
     * register calling is left-right
     * parameter ordering
     * left-right calling inserts result parameter last

compiler/symdef.pas

@@ -494,6 +494,13 @@ interface
            1 : (i : longint);
        end;
 
+       tinlininginfo = record
+         { node tree }
+          code : tnode;
+          flags : tprocinfoflags;
+       end;
+       pinlininginfo = ^tinlininginfo;
+
        tprocdef = class(tabstractprocdef)
        private
           _mangledname : pstring;
@@ -528,13 +535,11 @@ interface
           refcount : longint;
           _class : tobjectdef;
           _classderef : tderef;
-          { it's a tree, but this not easy to handle }
-          { used for inlined procs                   }
-          code : tnode;
+
           { name of the result variable to insert in the localsymtable }
           resultname : stringid;
-          { true, if the procedure is only declared }
-          { (forward procedure) }
+          { true, if the procedure is only declared
+            (forward procedure) }
           forwarddef,
           { true if the procedure is declared in the interface }
           interfacedef : boolean;
@@ -542,6 +547,9 @@ interface
           hasforward : boolean;
           { check the problems of manglednames }
           has_mangledname : boolean;
+          { info for inlining the subroutine, if this pointer is nil,
+            the procedure can't be inlined }
+          inlininginfo : pinlininginfo;
           constructor create(level:byte);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
@@ -3597,7 +3605,11 @@ implementation
          interfacedef:=false;
          hasforward:=false;
          _class := nil;
-         code:=nil;
+         { only for non inlined procedures loaded from a unit
+           we don't need this info
+         }
+         new(inlininginfo);
+         fillchar(inlininginfo^,sizeof(tinlininginfo),0);
          overloadnumber:=0;
 {$ifdef GDB}
          isstabwritten := false;
@@ -3647,9 +3659,13 @@ implementation
 
          { inline stuff }
          if proccalloption=pocall_inline then
-           code:=ppuloadnodetree(ppufile)
+           begin
+             new(inlininginfo);
+             inlininginfo^.code:=ppuloadnodetree(ppufile);
+             ppufile.getsmallset(inlininginfo^.flags);
+           end
          else
-           code := nil;
+           inlininginfo := nil;
 
          { default values for no persistent data }
          if (cs_link_deffile in aktglobalswitches) and
@@ -3688,16 +3704,18 @@ implementation
             memproclocalst.start;
 {$endif MEMDEBUG}
           end;
-         if (proccalloption=pocall_inline) and assigned(code) then
+         if (proccalloption=pocall_inline) and assigned(inlininginfo) then
           begin
 {$ifdef MEMDEBUG}
             memprocnodetree.start;
 {$endif MEMDEBUG}
-            tnode(code).free;
+            tnode(inlininginfo^.code).free;
 {$ifdef MEMDEBUG}
             memprocnodetree.start;
 {$endif MEMDEBUG}
           end;
+         if assigned(inlininginfo) then
+           dispose(inlininginfo);
          if (po_msgstr in procoptions) then
            strdispose(messageinf.str);
          if assigned(_mangledname) then
@@ -3774,7 +3792,11 @@ implementation
          oldintfcrc:=ppufile.do_crc;
          ppufile.do_crc:=false;
          if proccalloption=pocall_inline then
-           ppuwritenodetree(ppufile,code);
+           begin
+             ppuwritenodetree(ppufile,inlininginfo^.code);
+             ppufile.putsmallset(inlininginfo^.flags);
+           end;
+
          ppufile.do_crc:=oldintfcrc;
 
          aktparasymtable:=oldparasymtable;
@@ -3792,7 +3814,6 @@ implementation
      end;
 
 
-
     function tprocdef.fullprocname(showhidden:boolean):string;
       var
         s : string;
@@ -4169,7 +4190,7 @@ implementation
 
          { inline tree }
          if (proccalloption=pocall_inline) then
-           code.buildderefimpl;
+           inlininginfo^.code.buildderefimpl;
 
          aktparasymtable:=oldparasymtable;
          aktlocalsymtable:=oldlocalsymtable;
@@ -4229,7 +4250,7 @@ implementation
 
         { inline tree }
         if (proccalloption=pocall_inline) then
-          code.derefimpl;
+          inlininginfo^.code.derefimpl;
 
         aktparasymtable:=oldparasymtable;
         aktlocalsymtable:=oldlocalsymtable;
@@ -6118,7 +6139,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.192  2003-12-12 12:09:40  marco
+  Revision 1.193  2003-12-16 21:29:24  florian
+    + inlined procedures inherit procinfo flags
+
+  Revision 1.192  2003/12/12 12:09:40  marco
    * always generate RTTI patch from peter
 
   Revision 1.191  2003/12/08 22:34:24  peter

compiler/utils/ppudump.pp

@@ -43,6 +43,20 @@ const
   v_all            = $ff;
 
 type
+  tprocinfoflag=(
+    {# procedure uses asm }
+    pi_uses_asm,
+    {# procedure does a call }
+    pi_do_call,
+    {# procedure has a try statement = no register optimization }
+    pi_uses_exceptions,
+    {# procedure is declared as @var(assembler), don't optimize}
+    pi_is_assembler,
+    {# procedure contains data which needs to be finalized }
+    pi_needs_implicit_finally
+  );
+  tprocinfoflags=set of tprocinfoflag;
+
   { Copied from systems.pas }
   ttargetcpu=
   (
@@ -1219,6 +1233,8 @@ var
   totaldefs,l,j,
   defcnt : longint;
   calloption : tproccalloption;
+  procinfooptions : tprocinfoflag;
+
 begin
   defcnt:=0;
   with ppufile do
@@ -1330,7 +1346,11 @@ begin
               end;
              { code }
              if (calloption=pocall_inline) then
-               readnodetree;
+               begin
+                 readnodetree;
+                 ppufile.getsmallset(procinfooptions);
+                 writeln(space,'  ProcInfoOptions : ',dword(procinfooptions));
+               end;
              delete(space,1,4);
            end;
 
@@ -1929,7 +1949,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.49  2003-12-08 21:04:08  peter
+  Revision 1.50  2003-12-16 21:29:25  florian
+    + inlined procedures inherit procinfo flags
+
+  Revision 1.49  2003/12/08 21:04:08  peter
     * line break in uses unit
 
   Revision 1.48  2003/11/10 22:02:52  peter