* fix writing of goto node to ppu

* replace derefnode with resolveppuidx method that only needs to be
    implemented for nodes referencing other nodes
  * fix IE when a label is not defined in inline function

git-svn-id: trunk@11697 -

.gitattributes

@@ -8508,6 +8508,8 @@ tests/webtbs/tw11568.pp svneol=native#text/plain
 tests/webtbs/tw1157.pp svneol=native#text/plain
 tests/webtbs/tw1157b.pp svneol=native#text/plain
 tests/webtbs/tw11619.pp svneol=native#text/plain
+tests/webtbs/tw11762.pp svneol=native#text/plain
+tests/webtbs/tw11763.pp svneol=native#text/plain
 tests/webtbs/tw1181.pp svneol=native#text/plain
 tests/webtbs/tw11846a.pp svneol=native#text/plain
 tests/webtbs/tw11846b.pp svneol=native#text/plain
@@ -9424,6 +9426,7 @@ tests/webtbs/uw0701d.pp svneol=native#text/plain
 tests/webtbs/uw0701e.pp svneol=native#text/plain
 tests/webtbs/uw0809.pp svneol=native#text/plain
 tests/webtbs/uw11182.pp svneol=native#text/plain
+tests/webtbs/uw11762.pp svneol=native#text/plain
 tests/webtbs/uw1181.inc svneol=native#text/plain
 tests/webtbs/uw1279.pp svneol=native#text/plain
 tests/webtbs/uw1331.pp svneol=native#text/plain

compiler/nbas.pas

@@ -136,7 +136,6 @@ type
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          procedure derefnode;override;
           function dogetcopy: tnode; override;
           function pass_1 : tnode; override;
           function pass_typecheck: tnode; override;
@@ -153,8 +152,8 @@ type
           constructor create_offset(const temp: ttempcreatenode;aoffset:longint);
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure resolveppuidx;override;
           function dogetcopy: tnode; override;
-          procedure derefnode;override;
           function pass_1 : tnode; override;
           function pass_typecheck : tnode; override;
           procedure mark_write;override;
@@ -176,8 +175,8 @@ type
           constructor create_normal_temp(const temp: ttempcreatenode);
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure resolveppuidx;override;
           function dogetcopy: tnode; override;
-          procedure derefnode;override;
           function pass_1: tnode; override;
           function pass_typecheck: tnode; override;
           function docompare(p: tnode): boolean; override;
@@ -817,14 +816,6 @@ implementation
       end;
 
 
-    procedure ttempcreatenode.derefnode;
-      begin
-        inherited derefnode;
-        if assigned(tempinfo^.withnode) then
-          tempinfo^.withnode.derefnode;
-      end;
-
-
     function ttempcreatenode.pass_1 : tnode;
       begin
         result := nil;
@@ -933,11 +924,10 @@ implementation
       end;
 
 
-    procedure ttemprefnode.derefnode;
+    procedure ttemprefnode.resolveppuidx;
       var
         temp : ttempcreatenode;
       begin
-        inherited derefnode;
         temp:=ttempcreatenode(nodeppuidxget(tempidx));
         if temp.nodetype<>tempcreaten then
           internalerror(200311075);
@@ -1067,7 +1057,7 @@ implementation
       end;
 
 
-    procedure ttempdeletenode.derefnode;
+    procedure ttempdeletenode.resolveppuidx;
       var
         temp : ttempcreatenode;
       begin

compiler/ncal.pas

@@ -121,7 +121,6 @@ interface
           destructor destroy;override;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          procedure derefnode;override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
           function  dogetcopy : tnode;override;
@@ -995,20 +994,6 @@ implementation
       end;
 
 
-    procedure tcallnode.derefnode;
-      begin
-        if assigned(callinitblock) then
-          callinitblock.derefnode;
-        if assigned(methodpointer) then
-          methodpointer.derefnode;
-        if assigned(callcleanupblock) then
-          callcleanupblock.derefnode;
-        if assigned(funcretnode) then
-          funcretnode.derefnode;
-        inherited derefnode;
-      end;
-
-
     procedure tcallnode.buildderefimpl;
       begin
         inherited buildderefimpl;

compiler/nflw.pas

@@ -63,7 +63,6 @@ interface
           function dogetcopy : tnode;override;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          procedure derefnode;override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
           procedure insertintolist(l : tnodelist);override;
@@ -129,6 +128,9 @@ interface
        tcontinuenodeclass = class of tcontinuenode;
 
        tgotonode = class(tnode)
+       private
+          labelnodeidx : longint;
+       public
           labelsym : tlabelsym;
           labelnode : tlabelnode;
           exceptionblock : integer;
@@ -137,6 +139,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
+          procedure resolveppuidx;override;
           function dogetcopy : tnode;override;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
@@ -269,15 +272,6 @@ implementation
       end;
 
 
-    procedure tloopnode.derefnode;
-      begin
-        inherited derefnode;
-        if assigned(t1) then
-          t1.derefnode;
-        if assigned(t2) then
-          t2.derefnode;
-      end;
-
     procedure tloopnode.buildderefimpl;
       begin
         inherited buildderefimpl;
@@ -972,7 +966,7 @@ implementation
     constructor tgotonode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
       begin
         inherited ppuload(t,ppufile);
-        labelnode:=tlabelnode(ppuloadnoderef(ppufile));
+        labelnodeidx:=ppufile.getlongint;
         exceptionblock:=ppufile.getbyte;
       end;
 
@@ -980,7 +974,8 @@ implementation
     procedure tgotonode.ppuwrite(ppufile:tcompilerppufile);
       begin
         inherited ppuwrite(ppufile);
-        ppuwritenoderef(ppufile,labelnode);
+        labelnodeidx:=labelnode.ppuidx;
+        ppufile.putlongint(labelnodeidx);
         ppufile.putbyte(exceptionblock);
       end;
 
@@ -988,14 +983,20 @@ implementation
     procedure tgotonode.buildderefimpl;
       begin
         inherited buildderefimpl;
-        //!!! deref(labelnode);
       end;
 
 
     procedure tgotonode.derefimpl;
       begin
         inherited derefimpl;
-        //!!! deref(labelnode);
+      end;
+
+
+    procedure tgotonode.resolveppuidx;
+      begin
+        labelnode:=tlabelnode(nodeppuidxget(labelnodeidx));
+        if labelnode.nodetype<>labeln then
+          internalerror(200809021);
       end;
 
 
@@ -1036,17 +1037,23 @@ implementation
         p:=tgotonode(inherited dogetcopy);
         p.exceptionblock:=exceptionblock;
 
-        { force a valid labelnode }
+        { generate labelnode if not done yet }
         if not(assigned(labelnode)) then
           begin
             if assigned(labelsym) and assigned(labelsym.code) then
               labelnode:=tlabelnode(labelsym.code)
-            else
-              internalerror(200610291);
           end;
 
         p.labelsym:=labelsym;
-        p.labelnode:=tlabelnode(labelnode.dogetcopy);
+        if assigned(labelnode) then
+          p.labelnode:=tlabelnode(labelnode.dogetcopy)
+        else
+          begin
+            { don't trigger IE when there was already an error, i.e. the
+              label is not defined. See tw11763 (PFV) }
+            if errorcount=0 then
+              internalerror(200610291);
+          end;
         result:=p;
      end;
 

compiler/node.pas

@@ -271,6 +271,9 @@ interface
       pnode = ^tnode;
       { basic class for the intermediated representation fpc uses }
       tnode = class
+      private
+         fppuidx : longint;
+         function getppuidx:longint;
       public
          { type of this node }
          nodetype : tnodetype;
@@ -291,7 +294,6 @@ interface
          successor : tnode;
          { there are some properties about the node stored }
          flags  : tnodeflags;
-         ppuidx : longint;
          resultdef     : tdef;
          resultdefderef : tderef;
          fileinfo      : tfileposinfo;
@@ -306,7 +308,7 @@ interface
          procedure ppuwrite(ppufile:tcompilerppufile);virtual;
          procedure buildderefimpl;virtual;
          procedure derefimpl;virtual;
-         procedure derefnode;virtual;
+         procedure resolveppuidx;virtual;
 
          { toggles the flag }
          procedure toggleflag(f : tnodeflag);
@@ -362,6 +364,7 @@ interface
 
          { ensures that the optimizer info record is allocated }
          function allocoptinfo : poptinfo;inline;
+         property ppuidx:longint read getppuidx;
       end;
 
       tnodeclass = class of tnode;
@@ -380,7 +383,6 @@ interface
          procedure ppuwrite(ppufile:tcompilerppufile);override;
          procedure buildderefimpl;override;
          procedure derefimpl;override;
-         procedure derefnode;override;
          procedure concattolist(l : tlinkedlist);override;
          function ischild(p : tnode) : boolean;override;
          function docompare(p : tnode) : boolean;override;
@@ -398,7 +400,6 @@ interface
          procedure ppuwrite(ppufile:tcompilerppufile);override;
          procedure buildderefimpl;override;
          procedure derefimpl;override;
-         procedure derefnode;override;
          procedure concattolist(l : tlinkedlist);override;
          function ischild(p : tnode) : boolean;override;
          function docompare(p : tnode) : boolean;override;
@@ -418,7 +419,6 @@ interface
          procedure ppuwrite(ppufile:tcompilerppufile);override;
          procedure buildderefimpl;override;
          procedure derefimpl;override;
-         procedure derefnode;override;
          procedure concattolist(l : tlinkedlist);override;
          function ischild(p : tnode) : boolean;override;
          function docompare(p : tnode) : boolean;override;
@@ -441,8 +441,6 @@ interface
     procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
     function ppuloadnodetree(ppufile:tcompilerppufile):tnode;
     procedure ppuwritenodetree(ppufile:tcompilerppufile;n:tnode);
-    procedure ppuwritenoderef(ppufile:tcompilerppufile;n:tnode);
-    function ppuloadnoderef(ppufile:tcompilerppufile) : tnode;
 
     const
       printnodespacing = '   ';
@@ -481,40 +479,59 @@ implementation
  ****************************************************************************}
 
     var
-      nodeppudata : tdynamicarray;
+      nodeppulist : TFPObjectList;
       nodeppuidx  : longint;
 
 
     procedure nodeppuidxcreate;
       begin
-        nodeppudata:=tdynamicarray.create(1024);
+        nodeppulist:=TFPObjectList.Create(false);
         nodeppuidx:=0;
       end;
 
 
+    procedure nodeppuidxresolve;
+      var
+        i : longint;
+        n : tnode;
+      begin
+        for i:=0 to nodeppulist.count-1 do
+          begin
+            n:=tnode(nodeppulist[i]);
+            if assigned(n) then
+              n.resolveppuidx;
+          end;
+      end;
+
+
     procedure nodeppuidxfree;
       begin
-        nodeppudata.free;
+        nodeppulist.free;
-        nodeppudata:=nil;
+        nodeppulist:=nil;
+        nodeppuidx:=0;
       end;
 
 
     procedure nodeppuidxadd(n:tnode);
+      var
+        i : longint;
       begin
-        if n.ppuidx<0 then
+        i:=n.ppuidx;
+        if i<=0 then
           internalerror(200311072);
-        nodeppudata.seek(n.ppuidx*sizeof(pointer));
+        if i>=nodeppulist.capacity then
-        nodeppudata.write(n,sizeof(pointer));
+          nodeppulist.capacity:=((i div 1024)+1)*1024;
+        if i>=nodeppulist.count then
+          nodeppulist.count:=i+1;
+        nodeppulist[i]:=n;
       end;
 
 
     function nodeppuidxget(i:longint):tnode;
       begin
-        if i<0 then
+        if i<=0 then
-          internalerror(200311072);
-        nodeppudata.seek(i*sizeof(pointer));
-        if nodeppudata.read(result,sizeof(pointer))<>sizeof(pointer) then
           internalerror(200311073);
+        result:=tnode(nodeppulist[i]);
       end;
 
 
@@ -540,7 +557,7 @@ implementation
            //writeln('load: ',nodetype2str[t]);
            { generate node of the correct class }
            result:=nodeclass[t].ppuload(t,ppufile);
-           result.ppuidx:=hppuidx;
+           result.fppuidx:=hppuidx;
            nodeppuidxadd(result);
          end
         else
@@ -555,10 +572,6 @@ implementation
         { type, read by ppuloadnode }
         if assigned(n) then
          begin
-           if n.ppuidx=-1 then
-             internalerror(200311071);
-           n.ppuidx:=nodeppuidx;
-           inc(nodeppuidx);
            ppufile.putbyte(byte(n.nodetype));
            ppufile.putlongint(n.ppuidx);
            //writeln('write: ',nodetype2str[n.nodetype]);
@@ -569,38 +582,23 @@ implementation
       end;
 
 
-    procedure ppuwritenoderef(ppufile:tcompilerppufile;n:tnode);
-      begin
-        { writing of node references isn't implemented yet (FK) }
-        internalerror(200506181);
-      end;
-
-
-    function ppuloadnoderef(ppufile:tcompilerppufile) : tnode;
-      begin
-        { reading of node references isn't implemented yet (FK) }
-        internalerror(200506182);
-        { avoid warning }
-        result := nil;
-      end;
-
-
     function ppuloadnodetree(ppufile:tcompilerppufile):tnode;
       begin
         if ppufile.readentry<>ibnodetree then
           Message(unit_f_ppu_read_error);
         nodeppuidxcreate;
         result:=ppuloadnode(ppufile);
-        result.derefnode;
+        nodeppuidxresolve;
         nodeppuidxfree;
       end;
 
 
     procedure ppuwritenodetree(ppufile:tcompilerppufile;n:tnode);
       begin
-        nodeppuidx:=0;
+        nodeppuidxcreate;
         ppuwritenode(ppufile,n);
         ppufile.writeentry(ibnodetree);
+        nodeppuidxfree;
       end;
 
 
@@ -691,7 +689,6 @@ implementation
          localswitches:=current_settings.localswitches;
          resultdef:=nil;
          flags:=[];
-         ppuidx:=-1;
       end;
 
     constructor tnode.createforcopy;
@@ -713,7 +710,6 @@ implementation
         expectloc:=LOC_INVALID;
         { updated by secondpass }
         location.loc:=LOC_INVALID;
-        ppuidx:=-1;
       end;
 
 
@@ -727,6 +723,22 @@ implementation
       end;
 
 
+    function tnode.getppuidx:longint;
+      begin
+        if fppuidx=0 then
+          begin
+            inc(nodeppuidx);
+            fppuidx:=nodeppuidx;
+          end;
+         result:=fppuidx;
+       end;
+
+
+    procedure tnode.resolveppuidx;
+      begin
+      end;
+
+
     procedure tnode.buildderefimpl;
       begin
         resultdefderef.build(resultdef);
@@ -739,11 +751,6 @@ implementation
       end;
 
 
-    procedure tnode.derefnode;
-      begin
-      end;
-
-
     procedure tnode.toggleflag(f : tnodeflag);
       begin
          if f in flags then
@@ -944,14 +951,6 @@ implementation
       end;
 
 
-    procedure tunarynode.derefnode;
-      begin
-        inherited derefnode;
-        if assigned(left) then
-          left.derefnode;
-      end;
-
-
     function tunarynode.docompare(p : tnode) : boolean;
       begin
          docompare:=(inherited docompare(p) and
@@ -1047,14 +1046,6 @@ implementation
       end;
 
 
-    procedure tbinarynode.derefnode;
-      begin
-        inherited derefnode;
-        if assigned(right) then
-          right.derefnode;
-      end;
-
-
     procedure tbinarynode.concattolist(l : tlinkedlist);
       begin
          { we could change that depending on the number of }
@@ -1188,14 +1179,6 @@ implementation
       end;
 
 
-    procedure ttertiarynode.derefnode;
-      begin
-        inherited derefnode;
-        if assigned(third) then
-          third.derefnode;
-      end;
-
-
     function ttertiarynode.docompare(p : tnode) : boolean;
       begin
          docompare:=(inherited docompare(p) and

compiler/nset.pas

@@ -83,7 +83,6 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          procedure derefnode;override;
           function dogetcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
           function pass_typecheck:tnode;override;
@@ -590,18 +589,6 @@ implementation
       end;
 
 
-    procedure tcasenode.derefnode;
-      var
-        i : integer;
-      begin
-        inherited derefnode;
-        if assigned(elseblock) then
-          elseblock.derefnode;
-        for i:=0 to blocks.count-1 do
-          pcaseblock(blocks[i])^.statement.derefnode;
-      end;
-
-
     function tcasenode.pass_typecheck : tnode;
       begin
         result:=nil;

tests/webtbs/tw11762.pp

@@ -0,0 +1,11 @@
+uses uw11762;
+
+begin
+  i:=0;
+  p;
+  p;
+  p;
+  p;
+  if i<>4 then
+   halt(1);
+end.

tests/webtbs/tw11763.pp

@@ -0,0 +1,8 @@
+procedure p; inline;
+label x;
+begin
+    goto x
+end;
+begin
+end.
+

tests/webtbs/uw11762.pp

@@ -0,0 +1,17 @@
+unit uw11762;
+interface
+procedure p; inline;
+var
+  i : longint;
+implementation
+procedure p; inline;
+label x;
+begin
+    goto x;
+    i:=i+10;
+    x:
+    i:=i+1;
+end;
+begin
+end.
+