Selaa lähdekoodia

* ensure that the functions that insert the hidden parameters (function result, open array high parameters, etc.) are idempotent

Sven/Sarah Barth 2 vuotta sitten
vanhempi
commit
d5a538b590
1 muutettua tiedostoa jossa 94 lisäystä ja 60 poistoa
  1. 94 60
      compiler/pparautl.pas

+ 94 - 60
compiler/pparautl.pas

@@ -76,6 +76,8 @@ implementation
 
 
 
 
     procedure insert_funcret_para(pd:tabstractprocdef);
     procedure insert_funcret_para(pd:tabstractprocdef);
+      const
+        name_result='result';
       var
       var
         storepos : tfileposinfo;
         storepos : tfileposinfo;
         vs       : tparavarsym;
         vs       : tparavarsym;
@@ -87,7 +89,8 @@ implementation
            { if this was originally an anonymous function then this was already
            { if this was originally an anonymous function then this was already
              done earlier }
              done earlier }
            not ((pd.typ=procdef) and tprocdef(pd).was_anonymous) and
            not ((pd.typ=procdef) and tprocdef(pd).was_anonymous) and
-           paramanager.ret_in_param(pd.returndef,pd) then
+           paramanager.ret_in_param(pd.returndef,pd) and
+           not assigned(pd.parast.find(name_result)) then
          begin
          begin
            storepos:=current_tokenpos;
            storepos:=current_tokenpos;
            if pd.typ=procdef then
            if pd.typ=procdef then
@@ -113,7 +116,7 @@ implementation
            else
            else
              paranr:=paranr_result;
              paranr:=paranr_result;
            { Generate result variable accessing function result }
            { Generate result variable accessing function result }
-           vs:=cparavarsym.create('$result',paranr,vs_var,pd.returndef,[vo_is_funcret,vo_is_hidden_para]);
+           vs:=cparavarsym.create('$'+name_result,paranr,vs_var,pd.returndef,[vo_is_funcret,vo_is_hidden_para]);
            pd.parast.insertsym(vs);
            pd.parast.insertsym(vs);
            { Store this symbol as funcretsym for procedures }
            { Store this symbol as funcretsym for procedures }
            if pd.typ=procdef then
            if pd.typ=procdef then
@@ -125,12 +128,15 @@ implementation
 
 
 
 
     procedure insert_parentfp_para(pd:tabstractprocdef);
     procedure insert_parentfp_para(pd:tabstractprocdef);
+      const
+        name_parentfp='parentfp';
       var
       var
         storepos : tfileposinfo;
         storepos : tfileposinfo;
         vs       : tparavarsym;
         vs       : tparavarsym;
         paranr   : longint;
         paranr   : longint;
       begin
       begin
-        if pd.parast.symtablelevel>normal_function_level then
+        if (pd.parast.symtablelevel>normal_function_level) and
+           not assigned(pd.parast.find(name_parentfp)) then
           begin
           begin
             storepos:=current_tokenpos;
             storepos:=current_tokenpos;
             if pd.typ=procdef then
             if pd.typ=procdef then
@@ -157,14 +163,14 @@ implementation
                not assigned(pd.owner.defowner) or
                not assigned(pd.owner.defowner) or
                (pd.owner.defowner.typ<>procdef) then
                (pd.owner.defowner.typ<>procdef) then
               begin
               begin
-                vs:=cparavarsym.create('$parentfp',paranr,vs_value
+                vs:=cparavarsym.create('$'+name_parentfp,paranr,vs_value
                       ,parentfpvoidpointertype,[vo_is_parentfp,vo_is_hidden_para]);
                       ,parentfpvoidpointertype,[vo_is_parentfp,vo_is_hidden_para]);
               end
               end
             else
             else
               begin
               begin
                 if not assigned(tprocdef(pd.owner.defowner).parentfpstruct) then
                 if not assigned(tprocdef(pd.owner.defowner).parentfpstruct) then
                   build_parentfpstruct(tprocdef(pd.owner.defowner));
                   build_parentfpstruct(tprocdef(pd.owner.defowner));
-                vs:=cparavarsym.create('$parentfp',paranr,vs_value,
+                vs:=cparavarsym.create('$'+name_parentfp,paranr,vs_value,
                       tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
                       tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
               end;
               end;
             pd.parast.insertsym(vs);
             pd.parast.insertsym(vs);
@@ -175,6 +181,11 @@ implementation
 
 
 
 
     procedure insert_self_and_vmt_para(pd:tabstractprocdef);
     procedure insert_self_and_vmt_para(pd:tabstractprocdef);
+      const
+        name_cmd='_cmd';
+        name_self='self';
+        name_block_literal='_block_literal';
+        name_vmt='vmt';
       var
       var
         storepos : tfileposinfo;
         storepos : tfileposinfo;
         vs       : tparavarsym;
         vs       : tparavarsym;
@@ -188,55 +199,65 @@ implementation
            is_objc_class_or_protocol(tprocdef(pd).struct) and
            is_objc_class_or_protocol(tprocdef(pd).struct) and
            (pd.parast.symtablelevel=normal_function_level) then
            (pd.parast.symtablelevel=normal_function_level) then
           begin
           begin
-            { insert Objective-C self and selector parameters }
-            vs:=cparavarsym.create('$_cmd',paranr_objc_cmd,vs_value,objc_seltype,[vo_is_msgsel,vo_is_hidden_para]);
-            pd.parast.insertsym(vs);
-            { make accessible to code }
-            sl:=tpropaccesslist.create;
-            sl.addsym(sl_load,vs);
-            aliasvs:=cabsolutevarsym.create_ref('_CMD',objc_seltype,sl);
-            include(aliasvs.varoptions,vo_is_msgsel);
-            tlocalsymtable(tprocdef(pd).localst).insertsym(aliasvs);
-
-            if (po_classmethod in pd.procoptions) then
-              { compatible with what gcc does }
-              hdef:=objc_idtype
-            else
-              hdef:=tprocdef(pd).struct;
+            if not assigned(pd.parast.find(name_cmd)) or
+                not assigned(pd.parast.find(name_self)) then
+              begin
+                { insert Objective-C self and selector parameters }
+                vs:=cparavarsym.create('$'+name_cmd,paranr_objc_cmd,vs_value,objc_seltype,[vo_is_msgsel,vo_is_hidden_para]);
+                pd.parast.insertsym(vs);
+                { make accessible to code }
+                sl:=tpropaccesslist.create;
+                sl.addsym(sl_load,vs);
+                aliasvs:=cabsolutevarsym.create_ref('_CMD',objc_seltype,sl);
+                include(aliasvs.varoptions,vo_is_msgsel);
+                tlocalsymtable(tprocdef(pd).localst).insertsym(aliasvs);
 
 
-            vs:=cparavarsym.create('$self',paranr_objc_self,vs_value,hdef,[vo_is_self,vo_is_hidden_para]);
-            pd.parast.insertsym(vs);
+                if (po_classmethod in pd.procoptions) then
+                  { compatible with what gcc does }
+                  hdef:=objc_idtype
+                else
+                  hdef:=tprocdef(pd).struct;
+
+                vs:=cparavarsym.create('$'+name_self,paranr_objc_self,vs_value,hdef,[vo_is_self,vo_is_hidden_para]);
+                pd.parast.insertsym(vs);
+              end;
           end
           end
         else if (pd.typ=procvardef) and
         else if (pd.typ=procvardef) and
            pd.is_methodpointer then
            pd.is_methodpointer then
           begin
           begin
-            { Generate self variable }
-            vs:=cparavarsym.create('$self',paranr_self,vs_value,voidpointertype,[vo_is_self,vo_is_hidden_para]);
-            pd.parast.insertsym(vs);
+            if not assigned(pd.parast.find(name_self)) then
+              begin
+                { Generate self variable }
+                vs:=cparavarsym.create('$'+name_self,paranr_self,vs_value,voidpointertype,[vo_is_self,vo_is_hidden_para]);
+                pd.parast.insertsym(vs);
+              end;
           end
           end
         { while only procvardefs of this type can be declared in Pascal code,
         { while only procvardefs of this type can be declared in Pascal code,
           internally we also generate procdefs of this type when creating
           internally we also generate procdefs of this type when creating
           block wrappers }
           block wrappers }
         else if (po_is_block in pd.procoptions) then
         else if (po_is_block in pd.procoptions) then
           begin
           begin
-            { generate the first hidden parameter, which is a so-called "block
-              literal" describing the block and containing its invocation
-              procedure  }
-            hdef:=cpointerdef.getreusable(get_block_literal_type_for_proc(pd));
-            { mark as vo_is_parentfp so that proc2procvar comparisons will
-              succeed when assigning arbitrary routines to the block }
-            vs:=cparavarsym.create('$_block_literal',paranr_blockselfpara,vs_value,
-              hdef,[vo_is_hidden_para,vo_is_parentfp]
-            );
-            pd.parast.insertsym(vs);
-            if pd.typ=procdef then
+            if not assigned(pd.parast.find('$'+name_block_literal)) then
               begin
               begin
-                { make accessible to code }
-                sl:=tpropaccesslist.create;
-                sl.addsym(sl_load,vs);
-                aliasvs:=cabsolutevarsym.create_ref('FPC_BLOCK_SELF',hdef,sl);
-                include(aliasvs.varoptions,vo_is_parentfp);
-                tlocalsymtable(tprocdef(pd).localst).insertsym(aliasvs);
+                { generate the first hidden parameter, which is a so-called "block
+                  literal" describing the block and containing its invocation
+                  procedure  }
+                hdef:=cpointerdef.getreusable(get_block_literal_type_for_proc(pd));
+                { mark as vo_is_parentfp so that proc2procvar comparisons will
+                  succeed when assigning arbitrary routines to the block }
+                vs:=cparavarsym.create('$'+name_block_literal,paranr_blockselfpara,vs_value,
+                  hdef,[vo_is_hidden_para,vo_is_parentfp]
+                );
+                pd.parast.insertsym(vs);
+                if pd.typ=procdef then
+                  begin
+                    { make accessible to code }
+                    sl:=tpropaccesslist.create;
+                    sl.addsym(sl_load,vs);
+                    aliasvs:=cabsolutevarsym.create_ref('FPC_BLOCK_SELF',hdef,sl);
+                    include(aliasvs.varoptions,vo_is_parentfp);
+                    tlocalsymtable(tprocdef(pd).localst).insertsym(aliasvs);
+                  end;
               end;
               end;
           end
           end
         else
         else
@@ -264,9 +285,10 @@ implementation
                          { no vmt for record/type helper constructors }
                          { no vmt for record/type helper constructors }
                          is_objectpascal_helper(tprocdef(pd).struct) and
                          is_objectpascal_helper(tprocdef(pd).struct) and
                          (tobjectdef(tprocdef(pd).struct).extendeddef.typ<>objectdef)
                          (tobjectdef(tprocdef(pd).struct).extendeddef.typ<>objectdef)
-                       )) then
+                       )) and
+                   not assigned(pd.parast.find(name_vmt)) then
                  begin
                  begin
-                   vs:=cparavarsym.create('$vmt',paranr_vmt,vs_value,cclassrefdef.create(tprocdef(pd).struct),[vo_is_vmt,vo_is_hidden_para]);
+                   vs:=cparavarsym.create('$'+name_vmt,paranr_vmt,vs_value,cclassrefdef.create(tprocdef(pd).struct),[vo_is_vmt,vo_is_hidden_para]);
                    pd.parast.insertsym(vs);
                    pd.parast.insertsym(vs);
                  end;
                  end;
 
 
@@ -291,10 +313,10 @@ implementation
                       vsp:=vs_var;
                       vsp:=vs_var;
                     hdef:=selfdef;
                     hdef:=selfdef;
                   end;
                   end;
-                vs:=tparavarsym(pd.parast.find('self'));
+                vs:=tparavarsym(pd.parast.find(name_self));
                 if not assigned(vs) or (vs.typ<>paravarsym) or (vs.vardef<>hdef) then
                 if not assigned(vs) or (vs.typ<>paravarsym) or (vs.vardef<>hdef) then
                   begin
                   begin
-                    vs:=cparavarsym.create('$self',paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]);
+                    vs:=cparavarsym.create('$'+name_self,paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]);
                     pd.parast.insertsym(vs);
                     pd.parast.insertsym(vs);
                   end;
                   end;
 
 
@@ -384,7 +406,11 @@ implementation
 
 
 
 
     procedure insert_hidden_para(p:TObject;arg:pointer);
     procedure insert_hidden_para(p:TObject;arg:pointer);
+      const
+        name_high = 'high';
+        name_typinfo = 'typinfo';
       var
       var
+        n   : tsymstr;
         hvs : tparavarsym;
         hvs : tparavarsym;
         pd  : tabstractprocdef absolute arg;
         pd  : tabstractprocdef absolute arg;
       begin
       begin
@@ -415,19 +441,23 @@ implementation
            { needs high parameter ? }
            { needs high parameter ? }
            if paramanager.push_high_param(varspez,vardef,pd.proccalloption) then
            if paramanager.push_high_param(varspez,vardef,pd.proccalloption) then
              begin
              begin
+               n:=name_high+name;
+               if not assigned(owner.find(n)) then
+                 begin
 {$ifdef cpu8bitalu}
 {$ifdef cpu8bitalu}
-               if is_shortstring(vardef) then
-                 hvs:=cparavarsym.create('$high'+name,paranr+1,vs_const,aluuinttype,[vo_is_high_para,vo_is_hidden_para])
-               else
+                   if is_shortstring(vardef) then
+                     hvs:=cparavarsym.create('$'+n,paranr+1,vs_const,aluuinttype,[vo_is_high_para,vo_is_hidden_para])
+                   else
 {$endif cpu8bitalu}
 {$endif cpu8bitalu}
-                 hvs:=cparavarsym.create('$high'+name,paranr+1,vs_const,sizesinttype,[vo_is_high_para,vo_is_hidden_para]);
-               hvs.symoptions:=[];
-               owner.insertsym(hvs);
-               { don't place to register if it will be accessed from implicit finally block }
-               if (varspez=vs_value) and
-                  is_open_array(vardef) and
-                  is_managed_type(vardef) then
-                 hvs.varregable:=vr_none;
+                     hvs:=cparavarsym.create('$'+n,paranr+1,vs_const,sizesinttype,[vo_is_high_para,vo_is_hidden_para]);
+                   hvs.symoptions:=[];
+                   owner.insertsym(hvs);
+                   { don't place to register if it will be accessed from implicit finally block }
+                   if (varspez=vs_value) and
+                      is_open_array(vardef) and
+                      is_managed_type(vardef) then
+                     hvs.varregable:=vr_none;
+                 end;
              end
              end
            else
            else
             begin
             begin
@@ -448,9 +478,13 @@ implementation
                end;
                end;
               if (vardef.typ=formaldef) and (Tformaldef(vardef).typed) then
               if (vardef.typ=formaldef) and (Tformaldef(vardef).typed) then
                 begin
                 begin
-                  hvs:=cparavarsym.create('$typinfo'+name,paranr+1,vs_const,voidpointertype,
-                                          [vo_is_typinfo_para,vo_is_hidden_para]);
-                  owner.insertsym(hvs);
+                  n:=name_typinfo+name;
+                  if not assigned(owner.find(n)) then
+                    begin
+                      hvs:=cparavarsym.create('$'+n,paranr+1,vs_const,voidpointertype,
+                                              [vo_is_typinfo_para,vo_is_hidden_para]);
+                      owner.insertsym(hvs);
+                    end;
                 end;
                 end;
             end;
             end;
          end;
          end;