Browse Source

* keep track of symbols that are accessed from a nested/anonymous function that belong to a surrounding scope

Sven/Sarah Barth 4 years ago
parent
commit
d56a90e5ed
3 changed files with 62 additions and 0 deletions
  1. 2 0
      compiler/nld.pas
  2. 7 0
      compiler/procinfo.pas
  3. 53 0
      compiler/symdef.pas

+ 2 - 0
compiler/nld.pas

@@ -385,6 +385,8 @@ implementation
                      internalerror(200309289);
                    left:=cloadparentfpnode.create(tprocdef(symtable.defowner),lpf_forload);
                    current_procinfo.set_needs_parentfp(tprocdef(symtable.defowner).parast.symtablelevel);
+                   { reference this as a captured symbol }
+                   current_procinfo.add_captured_sym(symtableentry,fileinfo);
                    { reference in nested procedures, variable needs to be in memory }
                    { and behaves as if its address escapes its parent block         }
                    make_not_regable(self,[ra_different_scope]);

+ 7 - 0
compiler/procinfo.pas

@@ -185,6 +185,8 @@ unit procinfo;
           procedure add_local_ref_def(def:tdef);
           procedure export_local_ref_defs;
 
+          procedure add_captured_sym(sym:tsym;const fileinfo:tfileposinfo);
+
           function create_for_outlining(const basesymname: string; astruct: tabstractrecorddef; potype: tproctypeoption; resultdef: tdef; entrynodeinfo: tnode): tprocinfo;
 
           { Add to parent's list of nested procedures even if parent is a 'main' procedure }
@@ -357,6 +359,11 @@ implementation
           end;
       end;
 
+    procedure tprocinfo.add_captured_sym(sym:tsym;const fileinfo:tfileposinfo);
+      begin
+        procdef.add_captured_sym(sym,fileinfo);
+      end;
+
     function tprocinfo.create_for_outlining(const basesymname: string; astruct: tabstractrecorddef; potype: tproctypeoption; resultdef: tdef; entrynodeinfo: tnode): tprocinfo;
       begin
         result:=cprocinfo.create(self);

+ 53 - 0
compiler/symdef.pas

@@ -769,6 +769,13 @@ interface
        end;
        pinlininginfo = ^tinlininginfo;
 
+       tcapturedsyminfo = record
+         sym : tsym;
+         { the location where the symbol was first encountered }
+         fileinfo : tfileposinfo;
+       end;
+       pcapturedsyminfo = ^tcapturedsyminfo;
+
        timplprocdefinfo = record
           resultname : pshortstring;
           parentfpstruct: tsym;
@@ -782,6 +789,7 @@ interface
           interfacedef : boolean;
           hasforward  : boolean;
           is_implemented : boolean;
+          capturedsyms : tfplist;
        end;
        pimplprocdefinfo = ^timplprocdefinfo;
 
@@ -829,6 +837,7 @@ interface
          procedure SetHasInliningInfo(AValue: boolean);
          function Getis_implemented: boolean;
          procedure Setis_implemented(AValue: boolean);
+         function Getcapturedsyms:tfplist;
          function getparentfpsym: tsym;
        public
           messageinf : tmessageinf;
@@ -915,6 +924,8 @@ interface
           function get_funcretsym_info(out ressym: tsym; out resdef: tdef): boolean; virtual;
           function get_safecall_funcretsym_info(out ressym: tsym; out resdef: tdef): boolean; virtual;
 
+          procedure add_captured_sym(sym:tsym;const filepos:tfileposinfo);
+
           { returns whether the mangled name or any of its aliases is equal to
             s }
           function  has_alias_name(const s: TSymStr):boolean;
@@ -959,6 +970,8 @@ interface
           property parentfpsym: tsym read getparentfpsym;
           { true if the implementation part for this procdef has been handled }
           property is_implemented: boolean read Getis_implemented write Setis_implemented;
+          { valid if the procdef captures any symbols from outer scopes }
+          property capturedsyms:tfplist read Getcapturedsyms;
        end;
        tprocdefclass = class of tprocdef;
 
@@ -6075,6 +6088,15 @@ implementation
       end;
 
 
+    function tprocdef.Getcapturedsyms:tfplist;
+      begin
+        if not assigned(implprocdefinfo) then
+          result:=nil
+        else
+          result:=implprocdefinfo^.capturedsyms;
+      end;
+
+
     function tprocdef.store_localst: boolean;
       begin
         result:=has_inlininginfo or (df_generic in defoptions);
@@ -6483,10 +6505,19 @@ implementation
 
 
     procedure tprocdef.freeimplprocdefinfo;
+      var
+        i : longint;
       begin
         if assigned(implprocdefinfo) then
           begin
             stringdispose(implprocdefinfo^.resultname);
+            if assigned(implprocdefinfo^.capturedsyms) then
+              begin
+                for i:=0 to implprocdefinfo^.capturedsyms.count-1 do
+                  dispose(pcapturedsyminfo(implprocdefinfo^.capturedsyms[i]));
+              end;
+            implprocdefinfo^.capturedsyms.free;
+            implprocdefinfo^.capturedsyms:=nil;
             freemem(implprocdefinfo);
             implprocdefinfo:=nil;
           end;
@@ -6784,6 +6815,28 @@ implementation
       end;
 
 
+    procedure tprocdef.add_captured_sym(sym:tsym;const filepos:tfileposinfo);
+      var
+        i : longint;
+        capturedsym : pcapturedsyminfo;
+      begin
+        if not assigned(implprocdefinfo) then
+          internalerror(2021052601);
+        if not assigned(implprocdefinfo^.capturedsyms) then
+          implprocdefinfo^.capturedsyms:=tfplist.create;
+        for i:=0 to implprocdefinfo^.capturedsyms.count-1 do
+          begin
+            capturedsym:=pcapturedsyminfo(implprocdefinfo^.capturedsyms[i]);
+            if capturedsym^.sym=sym then
+              exit;
+          end;
+        new(capturedsym);
+        capturedsym^.sym:=sym;
+        capturedsym^.fileinfo:=filepos;
+        implprocdefinfo^.capturedsyms.add(capturedsym);
+      end;
+
+
     function tprocdef.has_alias_name(const s: TSymStr): boolean;
       var
         item : TCmdStrListItem;