* node optimizer branch merged

  * gotonode and gotolabel refactored
  * -Nu added to enable for loop unrolling

git-svn-id: trunk@446 -

.gitattributes

@@ -256,7 +256,9 @@ compiler/ogcoff.pas svneol=native#text/plain
 compiler/ogelf.pas svneol=native#text/plain
 compiler/oglx.pas svneol=native#text/plain
 compiler/ogmap.pas svneol=native#text/plain
+compiler/optcse.pas svneol=native#text/plain
 compiler/options.pas svneol=native#text/plain
+compiler/optunrol.pas svneol=native#text/plain
 compiler/owar.pas svneol=native#text/plain
 compiler/owbase.pas svneol=native#text/plain
 compiler/parabase.pas svneol=native#text/plain
@@ -5224,6 +5226,7 @@ tests/test/tsubdecl.pp svneol=native#text/plain
 tests/test/tunit1.pp svneol=native#text/plain
 tests/test/tunit2.pp svneol=native#text/plain
 tests/test/tunit3.pp svneol=native#text/plain
+tests/test/tunroll1.pp svneol=native#text/plain
 tests/test/tutf81.pp svneol=native#text/plain%3Bcharset%3Dutf-8
 tests/test/tutf82.pp svneol=native#text/plain%3Bcharset%3Dutf-8
 tests/test/twide1.pp svneol=native#text/plain

.gitignore

@@ -1,21 +1,12 @@
 compiler/*.bak
 compiler/*.exe
-compiler/*.o
-compiler/*.ppu
 compiler/*.s
-compiler/*.tmp
 compiler/alpha/*.bak
 compiler/alpha/*.exe
 compiler/alpha/*.s
 compiler/arm/*.bak
 compiler/arm/*.exe
 compiler/arm/*.s
-compiler/arm/fp.cfg
-compiler/arm/fp.dsk
-compiler/arm/fp.ini
-compiler/fp.cfg
-compiler/fp.dsk
-compiler/fp.ini
 compiler/html/*.bak
 compiler/html/*.exe
 compiler/html/*.s
@@ -28,18 +19,12 @@ compiler/html/powerpc/*.s
 compiler/i386/*.bak
 compiler/i386/*.exe
 compiler/i386/*.s
-compiler/i386/fp.cfg
-compiler/i386/fp.dsk
-compiler/i386/fp.ini
 compiler/ia64/*.bak
 compiler/ia64/*.exe
 compiler/ia64/*.s
 compiler/m68k/*.bak
 compiler/m68k/*.exe
 compiler/m68k/*.s
-compiler/m68k/fp.cfg
-compiler/m68k/fp.dsk
-compiler/m68k/fp.ini
 compiler/mips/*.bak
 compiler/mips/*.exe
 compiler/mips/*.s
@@ -49,15 +34,9 @@ compiler/msg/*.s
 compiler/powerpc/*.bak
 compiler/powerpc/*.exe
 compiler/powerpc/*.s
-compiler/powerpc/fp.cfg
-compiler/powerpc/fp.dsk
-compiler/powerpc/fp.ini
 compiler/sparc/*.bak
 compiler/sparc/*.exe
 compiler/sparc/*.s
-compiler/sparc/fp.cfg
-compiler/sparc/fp.dsk
-compiler/sparc/fp.ini
 compiler/systems/*.bak
 compiler/systems/*.exe
 compiler/systems/*.s
@@ -73,6 +52,3 @@ compiler/x86/*.s
 compiler/x86_64/*.bak
 compiler/x86_64/*.exe
 compiler/x86_64/*.s
-compiler/x86_64/fp.cfg
-compiler/x86_64/fp.dsk
-compiler/x86_64/fp.ini

compiler/globtype.pas

@@ -118,7 +118,7 @@ than 255 characters. That's why using Ansi Strings}
          cs_load_gpc_unit,
          { optimizer }
          cs_regvars,cs_no_regalloc,cs_uncertainopts,cs_littlesize,
-         cs_optimize,cs_fastoptimize,cs_slowoptimize,cs_align,
+         cs_optimize,cs_fastoptimize,cs_slowoptimize,cs_align,cs_loopunroll,
          { browser }
          cs_browser_log,
          { debugger }

compiler/nbas.pas

@@ -61,7 +61,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
           function docompare(p: tnode): boolean; override;
@@ -123,7 +123,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function getcopy: tnode; override;
+          function _getcopy: tnode; override;
           function pass_1 : tnode; override;
           function det_resulttype: tnode; override;
           function docompare(p: tnode): boolean; override;
@@ -137,7 +137,7 @@ interface
           constructor create_offset(const temp: ttempcreatenode;aoffset:longint);
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function getcopy: tnode; override;
+          function _getcopy: tnode; override;
           procedure derefnode;override;
           function pass_1 : tnode; override;
           function det_resulttype : tnode; override;
@@ -159,7 +159,7 @@ interface
           constructor create_normal_temp(const temp: ttempcreatenode);
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function getcopy: tnode; override;
+          function _getcopy: tnode; override;
           procedure derefnode;override;
           function pass_1: tnode; override;
           function det_resulttype: tnode; override;
@@ -622,11 +622,11 @@ implementation
       end;
 
 
-    function tasmnode.getcopy: tnode;
+    function tasmnode._getcopy: tnode;
       var
         n: tasmnode;
       begin
-        n := tasmnode(inherited getcopy);
+        n := tasmnode(inherited _getcopy);
         if assigned(p_asm) then
           begin
             n.p_asm:=taasmoutput.create;
@@ -634,7 +634,7 @@ implementation
           end
         else n.p_asm := nil;
         n.currenttai:=currenttai;
-        getcopy := n;
+        result:=n;
       end;
 
 
@@ -688,11 +688,11 @@ implementation
            (not tpointerdef(_restype.def).pointertype.def.needs_inittable));
       end;
 
-    function ttempcreatenode.getcopy: tnode;
+    function ttempcreatenode._getcopy: tnode;
       var
         n: ttempcreatenode;
       begin
-        n := ttempcreatenode(inherited getcopy);
+        n := ttempcreatenode(inherited _getcopy);
         n.size := size;
 
         new(n.tempinfo);
@@ -805,11 +805,11 @@ implementation
       end;
 
 
-    function ttemprefnode.getcopy: tnode;
+    function ttemprefnode._getcopy: tnode;
       var
         n: ttemprefnode;
       begin
-        n := ttemprefnode(inherited getcopy);
+        n := ttemprefnode(inherited _getcopy);
         n.offset := offset;
 
         if assigned(tempinfo^.hookoncopy) then
@@ -933,11 +933,11 @@ implementation
       end;
 
 
-    function ttempdeletenode.getcopy: tnode;
+    function ttempdeletenode._getcopy: tnode;
       var
         n: ttempdeletenode;
       begin
-        n := ttempdeletenode(inherited getcopy);
+        n := ttempdeletenode(inherited _getcopy);
         n.release_to_normal := release_to_normal;
 
         if assigned(tempinfo^.hookoncopy) then

compiler/ncal.pas

@@ -115,7 +115,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function  getcopy : tnode;override;
+          function  _getcopy : tnode;override;
           { Goes through all symbols in a class and subclasses and calls
             verify abstract for each .
           }
@@ -156,7 +156,7 @@ interface
           destructor destroy;override;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
           procedure get_paratype;
           procedure insert_typeconv(do_count : boolean);
@@ -433,13 +433,13 @@ type
       end;
 
 
-    function tcallparanode.getcopy : tnode;
+    function tcallparanode._getcopy : tnode;
 
       var
          n : tcallparanode;
 
       begin
-         n:=tcallparanode(inherited getcopy);
+         n:=tcallparanode(inherited _getcopy);
          n.callparaflags:=callparaflags;
          n.parasym:=parasym;
          result:=n;
@@ -979,7 +979,7 @@ type
       end;
 
 
-    function tcallnode.getcopy : tnode;
+    function tcallnode._getcopy : tnode;
       var
         n : tcallnode;
         i : integer;
@@ -991,7 +991,7 @@ type
           the can reference methodpointer }
         oldleft:=left;
         left:=nil;
-        n:=tcallnode(inherited getcopy);
+        n:=tcallnode(inherited _getcopy);
         left:=oldleft;
         n.symtableprocentry:=symtableprocentry;
         n.symtableproc:=symtableproc;
@@ -999,30 +999,30 @@ type
         n.restype := restype;
         n.callnodeflags := callnodeflags;
         if assigned(methodpointerinit) then
-         n.methodpointerinit:=tblocknode(methodpointerinit.getcopy)
+         n.methodpointerinit:=tblocknode(methodpointerinit._getcopy)
         else
          n.methodpointerinit:=nil;
         { methodpointerinit is copied, now references to the temp will also be copied
           correctly. We can now copy the parameters and methodpointer }
         if assigned(left) then
-         n.left:=left.getcopy
+         n.left:=left._getcopy
         else
          n.left:=nil;
         if assigned(methodpointer) then
-         n.methodpointer:=methodpointer.getcopy
+         n.methodpointer:=methodpointer._getcopy
         else
          n.methodpointer:=nil;
         if assigned(methodpointerdone) then
-         n.methodpointerdone:=tblocknode(methodpointerdone.getcopy)
+         n.methodpointerdone:=tblocknode(methodpointerdone._getcopy)
         else
          n.methodpointerdone:=nil;
         if assigned(_funcretnode) then
-         n._funcretnode:=_funcretnode.getcopy
+         n._funcretnode:=_funcretnode._getcopy
         else
          n._funcretnode:=nil;
 {$ifdef PASS2INLINE}
         if assigned(inlinecode) then
-         n.inlinecode:=inlinecode.getcopy
+         n.inlinecode:=inlinecode._getcopy
         else
          n.inlinecode:=nil;
 {$endif PASS2INLINE}

compiler/ncgflw.pas

@@ -27,7 +27,7 @@ unit ncgflw;
 interface
 
     uses
-      node,nflw;
+      aasmbase,node,nflw;
 
     type
        tcgwhilerepeatnode = class(twhilerepeatnode)
@@ -59,6 +59,10 @@ interface
        end;
 
        tcglabelnode = class(tlabelnode)
+       private
+          asmlabel : tasmlabel;
+       public
+          function getasmlabel : tasmlabel;
           procedure pass_2;override;
        end;
 
@@ -82,7 +86,7 @@ implementation
 
     uses
       verbose,globals,systems,globtype,
-      symconst,symdef,symsym,aasmbase,aasmtai,aasmcpu,defutil,
+      symconst,symdef,symsym,aasmtai,aasmcpu,defutil,
       procinfo,cgbase,pass_2,parabase,
       cpubase,cpuinfo,
       nld,ncon,
@@ -423,6 +427,9 @@ implementation
               cg.a_op_const_loc(exprasmlist,hop,1,left.location);
             end;
 
+         if assigned(entrylabel) then
+           cg.a_jmp_always(exprasmlist,tcglabelnode(entrylabel).getasmlabel);
+
          { align loop target }
          if not(cs_littlesize in aktglobalswitches) then
             exprasmList.concat(Tai_align.Create(aktalignment.loopalign));
@@ -745,7 +752,7 @@ implementation
 {$ifdef OLDREGVARS}
          load_all_regvars(exprasmlist);
 {$endif OLDREGVARS}
-         cg.a_jmp_always(exprasmlist,labsym.lab)
+         cg.a_jmp_always(exprasmlist,tcglabelnode(labelnode).getasmlabel)
        end;
 
 
@@ -753,6 +760,14 @@ implementation
                              SecondLabel
 *****************************************************************************}
 
+    function tcglabelnode.getasmlabel : tasmlabel;
+      begin
+        if not(assigned(asmlabel)) then
+          objectlibrary.getlabel(asmlabel);
+        result:=asmlabel
+      end;
+
+
     procedure tcglabelnode.pass_2;
       begin
          location_reset(location,LOC_VOID,OS_NO);
@@ -760,7 +775,7 @@ implementation
 {$ifdef OLDREGVARS}
          load_all_regvars(exprasmlist);
 {$endif OLDREGVARS}
-         cg.a_label(exprasmlist,labelnr);
+         cg.a_label(exprasmlist,getasmlabel);
          secondpass(left);
       end;
 

compiler/ncnv.pas

@@ -44,7 +44,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
@@ -175,7 +175,7 @@ interface
           constructor create(l,r : tnode);virtual;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
-          function getcopy: tnode;override;
+          function _getcopy: tnode;override;
           destructor destroy; override;
          protected
           call: tnode;
@@ -581,14 +581,14 @@ implementation
       end;
 
 
-    function ttypeconvnode.getcopy : tnode;
+    function ttypeconvnode._getcopy : tnode;
       var
          n : ttypeconvnode;
       begin
-         n:=ttypeconvnode(inherited getcopy);
+         n:=ttypeconvnode(inherited _getcopy);
          n.convtype:=convtype;
          n.totype:=totype;
-         getcopy:=n;
+         _getcopy:=n;
       end;
 
     procedure ttypeconvnode.printnodeinfo(var t : text);
@@ -2583,10 +2583,10 @@ implementation
       end;
 
 
-    function tasnode.getcopy: tnode;
+    function tasnode._getcopy: tnode;
 
       begin
-        result := inherited getcopy;
+        result := inherited _getcopy;
         if assigned(call) then
           tasnode(result).call := call.getcopy
         else

compiler/ncon.pas

@@ -41,7 +41,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
           function docompare(p: tnode) : boolean; override;
@@ -62,7 +62,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
           function docompare(p: tnode) : boolean; override;
@@ -78,7 +78,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
           function docompare(p: tnode) : boolean; override;
@@ -98,7 +98,7 @@ interface
           procedure buildderefimpl;override;
           procedure derefimpl;override;
           destructor destroy;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
           function getpcharcopy : pchar;
@@ -116,7 +116,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
           function docompare(p: tnode) : boolean; override;
@@ -135,7 +135,7 @@ interface
           constructor create(const g:tguid);virtual;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
           function docompare(p: tnode) : boolean; override;
@@ -314,16 +314,16 @@ implementation
       end;
 
 
-    function trealconstnode.getcopy : tnode;
+    function trealconstnode._getcopy : tnode;
 
       var
          n : trealconstnode;
 
       begin
-         n:=trealconstnode(inherited getcopy);
+         n:=trealconstnode(inherited _getcopy);
          n.value_real:=value_real;
          n.lab_real:=lab_real;
-         getcopy:=n;
+         _getcopy:=n;
       end;
 
     function trealconstnode.det_resulttype:tnode;
@@ -406,16 +406,16 @@ implementation
       end;
 
 
-    function tordconstnode.getcopy : tnode;
+    function tordconstnode._getcopy : tnode;
 
       var
          n : tordconstnode;
 
       begin
-         n:=tordconstnode(inherited getcopy);
+         n:=tordconstnode(inherited _getcopy);
          n.value:=value;
          n.restype := restype;
-         getcopy:=n;
+         _getcopy:=n;
       end;
 
     function tordconstnode.det_resulttype:tnode;
@@ -491,16 +491,16 @@ implementation
       end;
 
 
-    function tpointerconstnode.getcopy : tnode;
+    function tpointerconstnode._getcopy : tnode;
 
       var
          n : tpointerconstnode;
 
       begin
-         n:=tpointerconstnode(inherited getcopy);
+         n:=tpointerconstnode(inherited _getcopy);
          n.value:=value;
          n.restype := restype;
-         getcopy:=n;
+         _getcopy:=n;
       end;
 
     function tpointerconstnode.det_resulttype:tnode;
@@ -645,13 +645,13 @@ implementation
       end;
 
 
-    function tstringconstnode.getcopy : tnode;
+    function tstringconstnode._getcopy : tnode;
 
       var
          n : tstringconstnode;
 
       begin
-         n:=tstringconstnode(inherited getcopy);
+         n:=tstringconstnode(inherited _getcopy);
          n.st_type:=st_type;
          n.len:=len;
          n.lab_str:=lab_str;
@@ -662,7 +662,7 @@ implementation
            end
          else
            n.value_str:=getpcharcopy;
-         getcopy:=n;
+         _getcopy:=n;
       end;
 
     function tstringconstnode.det_resulttype:tnode;
@@ -783,13 +783,13 @@ implementation
       end;
 
 
-    function tsetconstnode.getcopy : tnode;
+    function tsetconstnode._getcopy : tnode;
 
       var
          n : tsetconstnode;
 
       begin
-         n:=tsetconstnode(inherited getcopy);
+         n:=tsetconstnode(inherited _getcopy);
          if assigned(value_set) then
            begin
               new(n.value_set);
@@ -799,7 +799,7 @@ implementation
            n.value_set:=nil;
          n.restype := restype;
          n.lab_set:=lab_set;
-         getcopy:=n;
+         _getcopy:=n;
       end;
 
     function tsetconstnode.det_resulttype:tnode;
@@ -872,15 +872,15 @@ implementation
       end;
 
 
-    function tguidconstnode.getcopy : tnode;
+    function tguidconstnode._getcopy : tnode;
 
       var
          n : tguidconstnode;
 
       begin
-         n:=tguidconstnode(inherited getcopy);
+         n:=tguidconstnode(inherited _getcopy);
          n.value:=value;
-         getcopy:=n;
+         _getcopy:=n;
       end;
 
     function tguidconstnode.det_resulttype:tnode;

compiler/nflw.pas

@@ -27,9 +27,11 @@ unit nflw;
 interface
 
     uses
-       node,cpubase,
-       aasmbase,aasmtai,aasmcpu,symnot,
-       symtype,symbase,symdef,symsym;
+      classes,
+      node,cpubase,
+      symnot,
+      symtype,symbase,symdef,symsym,
+      optunrol;
 
     type
        { flags used by loop nodes }
@@ -51,12 +53,14 @@ interface
          loopflagsequal = [lnf_backward];
 
     type
+       tlabelnode = class;
+
        tloopnode = class(tbinarynode)
           t1,t2 : tnode;
           loopflags : tloopflags;
           constructor create(tt : tnodetype;l,r,_t1,_t2 : tnode);virtual;
           destructor destroy;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
@@ -84,6 +88,10 @@ interface
        tifnodeclass = class of tifnode;
 
        tfornode = class(tloopnode)
+          { if count isn divisable by unrolls then
+            the for loop must jump to this label to get the correct
+            number of executions }
+          entrylabel : tnode;
           loopvar_notid:cardinal;
           constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual;
           procedure loop_var_access(not_type:Tnotification_flag;symbol:Tsym);
@@ -116,17 +124,20 @@ interface
        tcontinuenodeclass = class of tcontinuenode;
 
        tgotonode = class(tnode)
-          labsym : tlabelsym;
-          labsymderef : tderef;
+          { we still need this for resolving forward gotos }
+          labelsym : tlabelsym;
+          labelnode : tlabelnode;
           exceptionblock : integer;
 {          internlab : tinterngotolabel;}
-          constructor create(p : tlabelsym);virtual;
+          constructor create(p : tlabelnode);virtual;
+          { as long as we don't know the label node we can't resolve it }
+          constructor create_sym(p : tlabelsym);virtual;
 {          constructor createintern(g:tinterngotolabel);}
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
           function docompare(p: tnode): boolean; override;
@@ -134,17 +145,17 @@ interface
        tgotonodeclass = class of tgotonode;
 
        tlabelnode = class(tunarynode)
-          labelnr : tasmlabel;
-          labsym : tlabelsym;
-          labsymderef : tderef;
           exceptionblock : integer;
-          constructor createcase(p : tasmlabel;l:tnode);virtual;
-          constructor create(p : tlabelsym;l:tnode);virtual;
+          { when copying trees, this points to the newly created copy of a label }
+          copiedto : tlabelnode;
+          { contains all goto nodesrefering to this label }
+          referinggotonodes : tlist;
+          constructor create(l:tnode);virtual;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
           function docompare(p: tnode): boolean; override;
@@ -158,7 +169,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
@@ -190,7 +201,7 @@ interface
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function docompare(p: tnode): boolean; override;
        end;
        tonnodeclass = class of tonnode;
@@ -282,23 +293,23 @@ implementation
       end;
 
 
-    function tloopnode.getcopy : tnode;
+    function tloopnode._getcopy : tnode;
 
       var
          p : tloopnode;
 
       begin
-         p:=tloopnode(inherited getcopy);
+         p:=tloopnode(inherited _getcopy);
          if assigned(t1) then
-           p.t1:=t1.getcopy
+           p.t1:=t1._getcopy
          else
            p.t1:=nil;
          if assigned(t2) then
-           p.t2:=t2.getcopy
+           p.t2:=t2._getcopy
          else
            p.t2:=nil;
          p.loopflags:=loopflags;
-         getcopy:=p;
+         _getcopy:=p;
       end;
 
     procedure tloopnode.insertintolist(l : tnodelist);
@@ -355,14 +366,14 @@ implementation
          resulttypepass(left);
          {A not node can be removed.}
          if left.nodetype=notn then
-            begin
-                t:=Tunarynode(left);
-                left:=Tunarynode(left).left;
-                t.left:=nil;
-                t.destroy;
-                {Symdif operator, in case you are wondering:}
-                loopflags:=loopflags >< [lnf_checknegate];
-            end;
+           begin
+             t:=Tunarynode(left);
+             left:=Tunarynode(left).left;
+             t.left:=nil;
+             t.destroy;
+             {Symdif operator, in case you are wondering:}
+             loopflags:=loopflags >< [lnf_checknegate];
+           end;
          { loop instruction }
          if assigned(right) then
            resulttypepass(right);
@@ -671,10 +682,24 @@ implementation
     end;
 
     function tfornode.det_resulttype:tnode;
+      var
+        unrollres : tnode;
       begin
          result:=nil;
          resulttype:=voidtype;
 
+         { loop unrolling }
+         if cs_loopunroll in aktglobalswitches then
+           begin
+             unrollres:=unroll_loop(self);
+             if assigned(unrollres) then
+               begin
+                 resulttypepass(unrollres);
+                 result:=unrollres;
+                 exit;
+               end;
+           end;
+
          { process the loopvar, from and to, varstates are already set }
          resulttypepass(left);
          resulttypepass(right);
@@ -878,18 +903,31 @@ implementation
                              TGOTONODE
 *****************************************************************************}
 
-    constructor tgotonode.create(p : tlabelsym);
+    constructor tgotonode.create(p : tlabelnode);
+      begin
+        inherited create(goton);
+        exceptionblock:=aktexceptblock;
+        labelnode:=p;
+        labelsym:=nil;
+      end;
+
+
+    constructor tgotonode.create_sym(p : tlabelsym);
       begin
         inherited create(goton);
         exceptionblock:=aktexceptblock;
-        labsym:=p;
+        if assigned(p.code) then
+          labelnode:=tlabelnode(p.code)
+        else
+          labelnode:=nil;
+        labelsym:=p;
       end;
 
 
     constructor tgotonode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
       begin
         inherited ppuload(t,ppufile);
-        ppufile.getderef(labsymderef);
+        labelnode:=tlabelnode(ppuloadnoderef(ppufile));
         exceptionblock:=ppufile.getbyte;
       end;
 
@@ -897,7 +935,7 @@ implementation
     procedure tgotonode.ppuwrite(ppufile:tcompilerppufile);
       begin
         inherited ppuwrite(ppufile);
-        ppufile.putderef(labsymderef);
+        ppuwritenoderef(ppufile,labelnode);
         ppufile.putbyte(exceptionblock);
       end;
 
@@ -905,14 +943,14 @@ implementation
     procedure tgotonode.buildderefimpl;
       begin
         inherited buildderefimpl;
-        labsymderef.build(labsym);
+        //!!! deref(labelnode);
       end;
 
 
     procedure tgotonode.derefimpl;
       begin
         inherited derefimpl;
-        labsym:=tlabelsym(labsymderef.resolve);
+        //!!! deref(labelnode);
       end;
 
 
@@ -925,23 +963,53 @@ implementation
 
     function tgotonode.pass_1 : tnode;
       begin
-         result:=nil;
-         expectloc:=LOC_VOID;
-         { check if }
-         if assigned(labsym) and
-            assigned(labsym.code) and
-            (exceptionblock<>tlabelnode(labsym.code).exceptionblock) then
-           CGMessage(cg_e_goto_inout_of_exception_block);
+        result:=nil;
+        expectloc:=LOC_VOID;
+
+        if not(assigned(labelnode)) then
+          begin
+            if assigned(labelsym.code) then
+              labelnode:=tlabelnode(labelsym.code)
+            else
+              internalerror(200506183);
+          end;
+
+        { check if we don't mess with exception blocks }
+        if assigned(labelnode) and
+           (exceptionblock<>labelnode.exceptionblock) then
+          CGMessage(cg_e_goto_inout_of_exception_block);
       end;
 
 
-   function tgotonode.getcopy : tnode;
+   function tgotonode._getcopy : tnode;
      var
-        p : tgotonode;
+       p : tgotonode;
+       i : aint;
      begin
-        p:=tgotonode(inherited getcopy);
-        p.labsym:=labsym;
+        p:=tgotonode(inherited _getcopy);
+        {
         p.exceptionblock:=exceptionblock;
+        { When we copying, we do an ugly trick to determine if the label used
+          by the current goto node is already copied: if the referinggotonodes
+          contains the current label, it isn't copied yet, so copy also the
+          label node and set the copiedto field to the newly created node.
+
+          If a label to copy is reached the copiedto field is checked. If it's non nil
+          the copiedto field is returned and the copiedto field is reset to nil.
+        }
+        { assume no copying }
+        newlabelnode:=labelnode;
+        for i:=0 to labelnode.copiedto.referingotonodes.count-1 do
+          begin
+            { copy labelnode? }
+            if labelnode.copiedto.referinggotonodes[i]=self then
+              begin
+                oldlabelnode.copiedto:=newlabelnode;
+              end;
+          end;
+        p.labelnode:=newlabelnode;
+        p.labelnode.referinggotonodes.add(self);
+        }
         result:=p;
      end;
 
@@ -956,32 +1024,16 @@ implementation
                              TLABELNODE
 *****************************************************************************}
 
-    constructor tlabelnode.createcase(p : tasmlabel;l:tnode);
-      begin
-        inherited create(labeln,l);
-        { it shouldn't be possible to jump to case labels using goto }
-        exceptionblock:=-1;
-        labsym:=nil;
-        labelnr:=p;
-      end;
-
-
-    constructor tlabelnode.create(p : tlabelsym;l:tnode);
+    constructor tlabelnode.create(l:tnode);
       begin
         inherited create(labeln,l);
         exceptionblock:=aktexceptblock;
-        labsym:=p;
-        labelnr:=p.lab;
-        { save the current labelnode in the labelsym }
-        p.code:=self;
       end;
 
 
     constructor tlabelnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
       begin
         inherited ppuload(t,ppufile);
-        ppufile.getderef(labsymderef);
-        labelnr:=tasmlabel(ppufile.getasmsymbol);
         exceptionblock:=ppufile.getbyte;
       end;
 
@@ -989,8 +1041,6 @@ implementation
     procedure tlabelnode.ppuwrite(ppufile:tcompilerppufile);
       begin
         inherited ppuwrite(ppufile);
-        ppufile.putderef(labsymderef);
-        ppufile.putasmsymbol(labelnr);
         ppufile.putbyte(exceptionblock);
       end;
 
@@ -998,15 +1048,12 @@ implementation
     procedure tlabelnode.buildderefimpl;
       begin
         inherited buildderefimpl;
-        labsymderef.build(labsym);
       end;
 
 
     procedure tlabelnode.derefimpl;
       begin
         inherited derefimpl;
-        labsym:=tlabelsym(labsymderef.resolve);
-        objectlibrary.derefasmsymbol(tasmsymbol(labelnr));
       end;
 
 
@@ -1036,14 +1083,13 @@ implementation
       end;
 
 
-   function tlabelnode.getcopy : tnode;
+   function tlabelnode._getcopy : tnode;
      var
         p : tlabelnode;
      begin
-        p:=tlabelnode(inherited getcopy);
-        p.labelnr:=labelnr;
+        p:=tlabelnode(inherited _getcopy);
         p.exceptionblock:=exceptionblock;
-        p.labsym:=labsym;
+
         result:=p;
      end;
 
@@ -1095,16 +1141,16 @@ implementation
       end;
 
 
-    function traisenode.getcopy : tnode;
+    function traisenode._getcopy : tnode;
       var
          n : traisenode;
       begin
-         n:=traisenode(inherited getcopy);
+         n:=traisenode(inherited _getcopy);
          if assigned(frametree) then
-           n.frametree:=frametree.getcopy
+           n.frametree:=frametree._getcopy
          else
            n.frametree:=nil;
-         getcopy:=n;
+         _getcopy:=n;
       end;
 
 
@@ -1314,11 +1360,11 @@ implementation
       end;
 
 
-    function tonnode.getcopy : tnode;
+    function tonnode._getcopy : tnode;
       var
          n : tonnode;
       begin
-         n:=tonnode(inherited getcopy);
+         n:=tonnode(inherited _getcopy);
          n.exceptsymtable:=exceptsymtable.getcopy;
          n.excepttype:=excepttype;
          result:=n;

compiler/ninl.pas

@@ -36,7 +36,7 @@ interface
           constructor create(number : byte;is_const:boolean;l : tnode);virtual;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
           function docompare(p: tnode): boolean; override;
@@ -116,11 +116,11 @@ implementation
       end;
 
 
-    function tinlinenode.getcopy : tnode;
+    function tinlinenode._getcopy : tnode;
       var
          n : tinlinenode;
       begin
-         n:=tinlinenode(inherited getcopy);
+         n:=tinlinenode(inherited _getcopy);
          n.inlinenumber:=inlinenumber;
          result:=n;
       end;

compiler/nld.pas

@@ -47,7 +47,7 @@ interface
           procedure derefimpl;override;
           procedure set_mp(p:tnode);
           function  is_addr_param_load:boolean;
-          function  getcopy : tnode;override;
+          function  _getcopy : tnode;override;
           function  pass_1 : tnode;override;
           function  det_resulttype:tnode;override;
           procedure mark_write;override;
@@ -64,7 +64,7 @@ interface
           constructor create(l,r : tnode);virtual;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
        {$ifdef state_tracking}
@@ -83,7 +83,7 @@ interface
 
        tarrayconstructornode = class(tbinarynode)
           constructor create(l,r : tnode);virtual;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
           function docompare(p: tnode): boolean; override;
@@ -116,7 +116,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function  getcopy : tnode;override;
+          function  _getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
           function docompare(p: tnode): boolean; override;
@@ -213,12 +213,12 @@ implementation
       end;
 
 
-    function tloadnode.getcopy : tnode;
+    function tloadnode._getcopy : tnode;
       var
          n : tloadnode;
 
       begin
-         n:=tloadnode(inherited getcopy);
+         n:=tloadnode(inherited _getcopy);
          n.symtable:=symtable;
          n.symtableentry:=symtableentry;
          n.procdef:=procdef;
@@ -475,15 +475,15 @@ implementation
       end;
 
 
-    function tassignmentnode.getcopy : tnode;
+    function tassignmentnode._getcopy : tnode;
 
       var
          n : tassignmentnode;
 
       begin
-         n:=tassignmentnode(inherited getcopy);
+         n:=tassignmentnode(inherited _getcopy);
          n.assigntype:=assigntype;
-         getcopy:=n;
+         result:=n;
       end;
 
 
@@ -860,11 +860,11 @@ implementation
       end;
 
 
-    function tarrayconstructornode.getcopy : tnode;
+    function tarrayconstructornode._getcopy : tnode;
       var
          n : tarrayconstructornode;
       begin
-         n:=tarrayconstructornode(inherited getcopy);
+         n:=tarrayconstructornode(inherited _getcopy);
          result:=n;
       end;
 
@@ -1161,11 +1161,11 @@ implementation
       end;
 
 
-    function trttinode.getcopy : tnode;
+    function trttinode._getcopy : tnode;
       var
          n : trttinode;
       begin
-         n:=trttinode(inherited getcopy);
+         n:=trttinode(inherited _getcopy);
          n.rttidef:=rttidef;
          n.rttitype:=rttitype;
          result:=n;

compiler/nmem.pas

@@ -47,7 +47,7 @@ interface
           procedure derefimpl;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
        end;
        tloadparentfpnodeclass = class of tloadparentfpnode;
 
@@ -61,7 +61,7 @@ interface
           procedure mark_write;override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
        end;
@@ -83,7 +83,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function pass_1 : tnode;override;
           function docompare(p: tnode): boolean; override;
           function det_resulttype:tnode;override;
@@ -107,7 +107,7 @@ interface
           destructor destroy;override;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           function pass_1 : tnode;override;
           function docompare(p: tnode): boolean; override;
           function det_resulttype:tnode;override;
@@ -218,13 +218,13 @@ implementation
       end;
 
 
-    function tloadparentfpnode.getcopy : tnode;
+    function tloadparentfpnode._getcopy : tnode;
       var
          p : tloadparentfpnode;
       begin
-         p:=tloadparentfpnode(inherited getcopy);
+         p:=tloadparentfpnode(inherited _getcopy);
          p.parentpd:=parentpd;
-         getcopy:=p;
+         _getcopy:=p;
       end;
 
 
@@ -318,15 +318,15 @@ implementation
       end;
 
 
-    function taddrnode.getcopy : tnode;
+    function taddrnode._getcopy : tnode;
 
       var
          p : taddrnode;
 
       begin
-         p:=taddrnode(inherited getcopy);
+         p:=taddrnode(inherited _getcopy);
          p.getprocvardef:=getprocvardef;
-         getcopy:=p;
+         _getcopy:=p;
       end;
 
 
@@ -552,15 +552,15 @@ implementation
       end;
 
 
-    function tsubscriptnode.getcopy : tnode;
+    function tsubscriptnode._getcopy : tnode;
 
       var
          p : tsubscriptnode;
 
       begin
-         p:=tsubscriptnode(inherited getcopy);
+         p:=tsubscriptnode(inherited _getcopy);
          p.vs:=vs;
-         getcopy:=p;
+         _getcopy:=p;
       end;
 
 
@@ -863,17 +863,17 @@ implementation
       end;
 
 
-    function twithnode.getcopy : tnode;
+    function twithnode._getcopy : tnode;
 
       var
          p : twithnode;
 
       begin
-         p:=twithnode(inherited getcopy);
+         p:=twithnode(inherited _getcopy);
          p.withsymtable:=withsymtable;
          p.tablecount:=tablecount;
          if assigned(p.withrefnode) then
-           p.withrefnode:=withrefnode.getcopy
+           p.withrefnode:=withrefnode._getcopy
          else
            p.withrefnode:=nil;
          result:=p;

compiler/node.pas

@@ -329,8 +329,11 @@ interface
           function isequal(p : tnode) : boolean;
           { to implement comparisation, override this method }
           function docompare(p : tnode) : boolean;virtual;
-          { gets a copy of the node }
-          function getcopy : tnode;virtual;
+          { wrapper for getcopy }
+          function getcopy : tnode;
+
+          { does the real copying of a node }
+          function _getcopy : tnode;virtual;
 
           procedure insertintolist(l : tnodelist);virtual;
           { writes a node for debugging purpose, shouldn't be called }
@@ -363,7 +366,7 @@ interface
           procedure concattolist(l : tlinkedlist);override;
           function ischild(p : tnode) : boolean;override;
           function docompare(p : tnode) : boolean;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
           procedure left_max;
           procedure printnodedata(var t:text);override;
@@ -383,7 +386,7 @@ interface
           function ischild(p : tnode) : boolean;override;
           function docompare(p : tnode) : boolean;override;
           procedure swapleftright;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
           procedure left_right_max;
           procedure printnodedata(var t:text);override;
@@ -404,6 +407,8 @@ 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 = '   ';
@@ -528,6 +533,20 @@ 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);
+      end;
+
+
     function ppuloadnodetree(ppufile:tcompilerppufile):tnode;
       begin
         if ppufile.readentry<>ibnodetree then
@@ -802,6 +821,12 @@ implementation
 
 
     function tnode.getcopy : tnode;
+      begin
+        result:=_getcopy;
+      end;
+
+
+    function tnode._getcopy : tnode;
       var
          p : tnode;
       begin
@@ -826,7 +851,7 @@ implementation
          p.firstpasscount:=firstpasscount;
 {$endif extdebug}
 {         p.list:=list; }
-         getcopy:=p;
+         result:=p;
       end;
 
 
@@ -899,16 +924,16 @@ implementation
       end;
 
 
-    function tunarynode.getcopy : tnode;
+    function tunarynode._getcopy : tnode;
       var
          p : tunarynode;
       begin
-         p:=tunarynode(inherited getcopy);
+         p:=tunarynode(inherited _getcopy);
          if assigned(left) then
-           p.left:=left.getcopy
+           p.left:=left._getcopy
          else
            p.left:=nil;
-         getcopy:=p;
+         result:=p;
       end;
 
 
@@ -1030,16 +1055,16 @@ implementation
       end;
 
 
-    function tbinarynode.getcopy : tnode;
+    function tbinarynode._getcopy : tnode;
       var
          p : tbinarynode;
       begin
-         p:=tbinarynode(inherited getcopy);
+         p:=tbinarynode(inherited _getcopy);
          if assigned(right) then
-           p.right:=right.getcopy
+           p.right:=right._getcopy
          else
            p.right:=nil;
-         getcopy:=p;
+         result:=p;
       end;
 
 

compiler/nopt.pas

@@ -40,7 +40,7 @@ type
      { By default, pass_2 is the same as for addnode           }
      { Only if there's a processor specific implementation, it }
      { will be overridden.                                     }
-     function getcopy: tnode; override;
+     function _getcopy: tnode; override;
      function docompare(p: tnode): boolean; override;
   end;
 
@@ -51,7 +51,7 @@ type
     { pass_1 must be overridden, otherwise we get an endless loop }
     function det_resulttype: tnode; override;
     function pass_1: tnode; override;
-    function getcopy: tnode; override;
+    function _getcopy: tnode; override;
     function docompare(p: tnode): boolean; override;
    protected
     procedure updatecurmaxlen;
@@ -101,13 +101,13 @@ begin
   subnodetype := ts;
 end;
 
-function taddoptnode.getcopy: tnode;
+function taddoptnode._getcopy: tnode;
 var
   hp: taddoptnode;
 begin
-  hp := taddoptnode(inherited getcopy);
+  hp := taddoptnode(inherited _getcopy);
   hp.subnodetype := subnodetype;
-  getcopy := hp;
+  _getcopy := hp;
 end;
 
 function taddoptnode.docompare(p: tnode): boolean;
@@ -143,13 +143,13 @@ begin
   include(current_procinfo.flags,pi_do_call);
 end;
 
-function taddsstringoptnode.getcopy: tnode;
+function taddsstringoptnode._getcopy: tnode;
 var
   hp: taddsstringoptnode;
 begin
-  hp := taddsstringoptnode(inherited getcopy);
+  hp := taddsstringoptnode(inherited _getcopy);
   hp.curmaxlen := curmaxlen;
-  getcopy := hp;
+  _getcopy := hp;
 end;
 
 function taddsstringoptnode.docompare(p: tnode): boolean;

compiler/nset.pas

@@ -82,7 +82,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
-          function getcopy : tnode;override;
+          function _getcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
           function det_resulttype:tnode;override;
           function pass_1 : tnode;override;
@@ -647,15 +647,15 @@ implementation
       end;
 
 
-    function tcasenode.getcopy : tnode;
+    function tcasenode._getcopy : tnode;
 
       var
          n : tcasenode;
          i : longint;
       begin
-         n:=tcasenode(inherited getcopy);
+         n:=tcasenode(inherited _getcopy);
          if assigned(elseblock) then
-           n.elseblock:=elseblock.getcopy
+           n.elseblock:=elseblock._getcopy
          else
            n.elseblock:=nil;
          if assigned(labels) then
@@ -669,12 +669,12 @@ implementation
                begin
                  if not assigned(blocks[i]) then
                    internalerror(200411302);
-                 n.addblock(i,pcaseblock(blocks[i])^.statement.getcopy);
+                 n.addblock(i,pcaseblock(blocks[i])^.statement._getcopy);
                end;
            end
          else
            n.labels:=nil;
-         getcopy:=n;
+         _getcopy:=n;
       end;
 
     procedure tcasenode.insertintolist(l : tnodelist);

compiler/optcse.pas

@@ -0,0 +1,56 @@
+unit optcse;
+
+  interface
+
+    procedure docse(rootnode : tnode);
+
+  implementation
+
+    procedure docse(rootnode : tnode);
+      begin
+        { create a linear list of nodes }
+
+        { create hash values }
+
+        { sort by hash values, taking care of nf_csebarrier and keeping the
+          original order of the nodes }
+
+        { compare nodes with equal hash values }
+
+        { search barrier }
+        for i:=0 to nodelist.length-1 do
+          begin
+            { and then search backward so we get always the largest equal trees }
+            j:=i+1;
+            { collect equal nodes }
+            while (j<=nodelist.length-1) and
+              nodelist[i].docompare(nodelist[j]) do
+              inc(j);
+            dec(j);
+            if j>i then
+              begin
+                { cse found }
+
+                { create temp. location }
+
+                { replace first node by
+                  - temp. creation
+                  - expression calculation
+                  - assignment of expression to temp. }
+                tempnode:=ctempcreatenode.create(nodelist[i].resulttype,nodelist[i].resulttype.def.size,tt_persistent,
+                  nodelist[i].resulttype.def.is_intregable or nodelist[i].resulttype.def.is_fpuregable);
+                addstatement(createstatement,tempnode);
+                addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
+                      caddrnode.create_internal(para.left)));
+                    para.left := ctypeconvnode.create_internal(cderefnode.create(ctemprefnode.create(tempnode)),para.left.resulttype);
+                    addstatement(deletestatement,ctempdeletenode.create(tempnode));
+
+                { replace next nodes by loading the temp. reference }
+
+                { replace last node by loading the temp. reference and
+                  delete the temp. }
+              end;
+          end;
+      end;
+
+end.

compiler/options.pas

@@ -875,6 +875,21 @@ begin
                  IllegalPara(opt);
              end;
 
+           'N' :
+             begin
+               j:=1;
+               while j<=length(more) do
+                begin
+                  case more[j] of
+                    'u' :
+                      initglobalswitches:=initglobalswitches+[cs_loopunroll];
+                     else
+                       IllegalPara(opt);
+                  end;
+                  inc(j);
+                end;
+             end;
+
            'o' :
              begin
                if More<>'' then

compiler/optunrol.pas

@@ -0,0 +1,123 @@
+unit optunrol;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      node;
+
+    function unroll_loop(node : tnode) : tnode;
+
+  implementation
+
+    uses
+      globtype,globals,
+      cpuinfo,
+      nutils,
+      nbas,nflw,ncon,ninl,ncal;
+
+    var
+      nodecount : aint;
+
+    function donodecount(var n: tnode; arg: pointer): foreachnoderesult;
+      begin
+        inc(nodecount);
+        result:=fen_false;
+      end;
+
+
+    { rough estimation how large the tree "node" is }
+    function countnodes(node : tnode) : aint;
+      begin
+        nodecount:=0;
+        foreachnodestatic(node,@donodecount,nil);
+        result:=nodecount;
+      end;
+
+
+    function number_unrolls(node : tnode) : integer;
+      begin
+{$ifdef i386}
+        { multiply by 2 for CPUs with a long pipeline }
+        if aktoptprocessor in [ClassPentium4] then
+          number_unrolls:=60 div countnodes(node)
+        else
+{$endif i386}
+          number_unrolls:=30 div countnodes(node);
+
+        if number_unrolls=0 then
+          number_unrolls:=1;
+      end;
+
+
+    function unroll_loop(node : tnode) : tnode;
+      var
+        unrolls,i : integer;
+        counts : qword;
+        unrollstatement : tstatementnode;
+        unrollblock : tblocknode;
+        entrylabel : tlabelnode;
+      begin
+        result:=nil;
+        if (cs_littlesize in aktglobalswitches) then
+          exit;
+        if not(node.nodetype in [forn]) then
+          exit;
+        unrolls:=number_unrolls(tfornode(node).t2);
+        if unrolls>1 then
+          begin
+            { number of executions known? }
+            if (tfornode(node).right.nodetype=ordconstn) and (tfornode(node).t1.nodetype=ordconstn) then
+              begin
+                if lnf_backward in tfornode(node).loopflags then
+                  counts:=tordconstnode(tfornode(node).right).value-tordconstnode(tfornode(node).t1).value+1
+                else
+                  counts:=tordconstnode(tfornode(node).t1).value-tordconstnode(tfornode(node).right).value+1;
+
+                { don't unroll more than we need }
+                if unrolls>counts then
+                  unrolls:=counts;
+
+                { create block statement }
+                unrollblock:=internalstatements(unrollstatement);
+
+                { let's unroll (and rock of course) }
+                for i:=1 to unrolls do
+                  begin
+                    { set and insert entry label? }
+                    if (counts mod unrolls<>0) and
+                      ((counts mod unrolls)=unrolls-i+1) then
+                      begin
+                        tfornode(node).entrylabel:=clabelnode.create(cnothingnode.create);
+                        addstatement(unrollstatement,tfornode(node).entrylabel);
+                      end;
+                    { create and insert copy of the statement block }
+                    addstatement(unrollstatement,tfornode(tfornode(node).t2).getcopy);
+
+                    { for itself increases at the last iteration }
+                    if i<unrolls then
+                      begin
+                        { insert incrementation of counter var }
+                        addstatement(unrollstatement,
+                          geninlinenode(in_inc_x,false,ccallparanode.create(tfornode(node).left.getcopy,nil)));
+                      end;
+                  end;
+                { can we get rid of the for statement? }
+                if unrolls=counts then
+                  result:=unrollblock;
+              end
+            else
+              begin
+                { for now, we can't handle this }
+                exit;
+              end;
+            if not(assigned(result)) then
+              begin
+                tfornode(node).t2.free;
+                tfornode(node).t2:=unrollblock;
+              end;
+          end;
+      end;
+
+end.

compiler/pdecl.pas

@@ -250,11 +250,10 @@ implementation
              consume(_ID)
            else
              begin
-                objectlibrary.getlabel(hl);
                 if token=_ID then
-                 symtablestack.insert(tlabelsym.create(orgpattern,hl))
+                 symtablestack.insert(tlabelsym.create(orgpattern))
                 else
-                 symtablestack.insert(tlabelsym.create(pattern,hl));
+                 symtablestack.insert(tlabelsym.create(pattern));
                 consume(token);
              end;
            if token<>_SEMICOLON then consume(_COMMA);

compiler/pexpr.pas

@@ -1466,7 +1466,8 @@ implementation
                         if tlabelsym(srsym).defined then
                           Message(sym_e_label_already_defined);
                         tlabelsym(srsym).defined:=true;
-                        p1:=clabelnode.create(tlabelsym(srsym),nil);
+                        p1:=clabelnode.create(nil);
+                        tlabelsym(srsym).code:=p1;
                       end;
                   end;
 

compiler/pstatmnt.pas

@@ -946,8 +946,8 @@ implementation
                          { goto is only allowed to labels within the current scope }
                          if srsym.owner<>current_procinfo.procdef.localst then
                            CGMessage(parser_e_goto_outside_proc);
-                         code:=cgotonode.create(tlabelsym(srsym));
-                         tgotonode(code).labsym:=tlabelsym(srsym);
+                         code:=cgotonode.create_sym(tlabelsym(srsym));
+                         tgotonode(code).labelsym:=tlabelsym(srsym);
                          { set flag that this label is used }
                          tlabelsym(srsym).used:=true;
                        end;
@@ -1011,7 +1011,8 @@ implementation
                    if tlabelsym(srsym).defined then
                     Message(sym_e_label_already_defined);
                    tlabelsym(srsym).defined:=true;
-                   p:=clabelnode.create(tlabelsym(srsym),nil);
+                   p:=clabelnode.create(nil);
+                   tlabelsym(srsym).code:=p;
                  end
                 else
                  begin

compiler/rautils.pas

@@ -1366,7 +1366,9 @@ Begin
   case sym.typ of
     labelsym :
       begin
-        hl:=tlabelsym(sym).lab;
+        if not(assigned(tlabelsym(sym).asmblocklabel)) then
+          objectlibrary.getlabel(tlabelsym(sym).asmblocklabel);
+        hl:=tlabelsym(sym).asmblocklabel;
         if emit then
          tlabelsym(sym).defined:=true
         else

compiler/symsym.pas

@@ -56,13 +56,18 @@ interface
        end;
 
        tlabelsym = class(tstoredsym)
-          lab     : tasmlabel;
           used,
           defined : boolean;
-          code : pointer; { should be tnode }
-          constructor create(const n : string; l : tasmlabel);
+          { points to the matching node, only valid resulttype pass is run and
+            the goto<->label relation in the node tree is created, should
+            be a tnode }
+          code : pointer;
+
+          { when the label is defined in an asm block, this points to the
+            generated asmlabel }
+          asmblocklabel : tasmlabel;
+          constructor create(const n : string);
           constructor ppuload(ppufile:tcompilerppufile);
-          function mangledname:string;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
 {$ifdef GDB}
           function  stabstring : pchar;override;
@@ -507,11 +512,10 @@ implementation
                                  TLABELSYM
 ****************************************************************************}
 
-    constructor tlabelsym.create(const n : string; l : tasmlabel);
+    constructor tlabelsym.create(const n : string);
       begin
          inherited create(n);
          typ:=labelsym;
-         lab:=l;
          used:=false;
          defined:=false;
          code:=nil;
@@ -522,21 +526,12 @@ implementation
       begin
          inherited ppuload(ppufile);
          typ:=labelsym;
-         { this is all dummy
-           it is only used for local browsing }
-         lab:=nil;
          code:=nil;
          used:=false;
          defined:=true;
       end;
 
 
-    function tlabelsym.mangledname:string;
-      begin
-        result:=lab.name;
-      end;
-
-
     procedure tlabelsym.ppuwrite(ppufile:tcompilerppufile);
       begin
          if owner.symtabletype=globalsymtable then

tests/test/tunroll1.pp

@@ -0,0 +1,15 @@
+{ %OPT=-Nu }
+var
+  i : integer;
+  s : single;
+
+begin
+  s:=0.0;
+  for i:=1 to 10 do
+    s:=s+1;
+  for i:=1 to 11 do
+    s:=s+1;
+  if s<>21 then
+    halt(1);
+  writeln('ok');
+end.