* block nodes within expressions shouldn't release the used registers,

    fixed using a flag till the new rg is ready

compiler/nbas.pas

@@ -1,6 +1,6 @@
 {
     $Id$
-    Copyright (c) 2000 by Florian Klaempfl
+    Copyright (c) 2000-2002 by Florian Klaempfl
 
     This unit implements some basic nodes
 
@@ -22,12 +22,15 @@
 }
 unit nbas;
 
-{$i defines.inc}
+{$i fpcdefs.inc}
 
 interface
 
     uses
-       aasm,symtype,node,cpubase;
+       cpubase,
+       aasmbase,aasmtai,aasmcpu,
+       node,
+       symtype,symppu;
 
     type
        tnothingnode = class(tnode)
@@ -41,6 +44,7 @@ interface
           constructor create;virtual;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
+          procedure mark_write;override;
        end;
        terrornodeclass = class of terrornode;
 
@@ -48,6 +52,9 @@ interface
           p_asm : taasmoutput;
           constructor create(p : taasmoutput);virtual;
           destructor destroy;override;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure derefimpl;override;
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
@@ -60,15 +67,18 @@ interface
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
 {$ifdef extdebug}
-          procedure dowrite;override;
+          procedure _dowrite;override;
 {$endif extdebug}
        end;
        tstatementnodeclass = class of tstatementnode;
 
        tblocknode = class(tunarynode)
-          constructor create(l : tnode);virtual;
+          constructor create(l : tnode;releasetemp : boolean);virtual;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
+{$ifdef state_tracking}
+          function track_state_pass(exec_known:boolean):boolean;override;
+{$endif state_tracking}
        end;
        tblocknodeclass = class of tblocknode;
 
@@ -79,10 +89,11 @@ interface
        ttempinfo = record
          { set to the copy of a tempcreate pnode (if it gets copied) so that the }
          { refs and deletenode can hook to this copy once they get copied too    }
-         hookoncopy : ptempinfo;
-         ref        : treference;
-         restype    : ttype;
-         valid      : boolean;
+         hookoncopy                 : ptempinfo;
+         ref                        : treference;
+         restype                    : ttype;
+         valid                      : boolean;
+         nextref_set_hookoncopy_nil : boolean;
        end;
 
        { a node which will create a (non)persistent temp of a given type with a given  }
@@ -113,6 +124,7 @@ interface
           function getcopy: tnode; override;
           function pass_1 : tnode; override;
           function det_resulttype : tnode; override;
+          procedure mark_write;override;
           function docompare(p: tnode): boolean; override;
          protected
           tempinfo: ptempinfo;
@@ -149,7 +161,7 @@ interface
 
        { Create a blocknode and statement node for multiple statements
          generated internally by the parser }
-       function  internalstatements(var laststatement:tstatementnode):tblocknode;
+       function  internalstatements(var laststatement:tstatementnode;releasetemp : boolean):tblocknode;
        procedure addstatement(var laststatement:tstatementnode;n:tnode);
 
 
@@ -158,9 +170,9 @@ implementation
     uses
       cutils,
       verbose,globals,globtype,systems,
-      symconst,symdef,symsym,types,
+      symconst,symdef,symsym,defutil,defcmp,
       pass_1,
-      ncal,nflw,rgobj,cgbase
+      nld,ncal,nflw,rgobj,cginfo,cgbase
       ;
 
 
@@ -168,20 +180,20 @@ implementation
                                      Helpers
 *****************************************************************************}
 
-    function internalstatements(var laststatement:tstatementnode):tblocknode;
+    function internalstatements(var laststatement:tstatementnode;releasetemp : boolean):tblocknode;
       begin
         { create dummy initial statement }
-        laststatement := cstatementnode.create(nil,cnothingnode.create);
-        internalstatements := cblocknode.create(laststatement);
+        laststatement := cstatementnode.create(cnothingnode.create,nil);
+        internalstatements := cblocknode.create(laststatement,releasetemp);
       end;
 
 
     procedure addstatement(var laststatement:tstatementnode;n:tnode);
       begin
-        if assigned(laststatement.left) then
+        if assigned(laststatement.right) then
          internalerror(200204201);
-        laststatement.left:=cstatementnode.create(nil,n);
-        laststatement:=tstatementnode(laststatement.left);
+        laststatement.right:=cstatementnode.create(n,nil);
+        laststatement:=tstatementnode(laststatement.right);
       end;
 
 
@@ -191,18 +203,21 @@ implementation
 
     constructor tnothingnode.create;
       begin
-         inherited create(nothingn);
+        inherited create(nothingn);
       end;
 
+
     function tnothingnode.det_resulttype:tnode;
       begin
-         result:=nil;
-         resulttype:=voidtype;
+        result:=nil;
+        resulttype:=voidtype;
       end;
 
+
     function tnothingnode.pass_1 : tnode;
       begin
-         result:=nil;
+        result:=nil;
+        expectloc:=LOC_VOID;
       end;
 
 
@@ -216,6 +231,7 @@ implementation
          inherited create(errorn);
       end;
 
+
     function terrornode.det_resulttype:tnode;
       begin
          result:=nil;
@@ -224,12 +240,19 @@ implementation
          resulttype:=generrortype;
       end;
 
+
     function terrornode.pass_1 : tnode;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          codegenerror:=true;
       end;
 
+
+    procedure terrornode.mark_write;
+      begin
+      end;
+
 {*****************************************************************************
                             TSTATEMENTNODE
 *****************************************************************************}
@@ -245,54 +268,54 @@ implementation
          result:=nil;
          resulttype:=voidtype;
 
-         { right is the statement itself calln assignn or a complex one }
-         resulttypepass(right);
+         { left is the statement itself calln assignn or a complex one }
+         resulttypepass(left);
          if (not (cs_extsyntax in aktmoduleswitches)) and
-            assigned(right.resulttype.def) and
-            not((right.nodetype=calln) and
-                (tcallnode(right).procdefinition.proctypeoption=potype_constructor)) and
-            not(is_void(right.resulttype.def)) then
+            assigned(left.resulttype.def) and
+            not((left.nodetype=calln) and
+                { don't complain when funcretrefnode is set, because then the
+                  value is already used. And also not for constructors }
+                (assigned(tcallnode(left).funcretrefnode) or
+                 (tcallnode(left).procdefinition.proctypeoption=potype_constructor))) and
+            not(is_void(left.resulttype.def)) then
            CGMessage(cg_e_illegal_expression);
          if codegenerror then
            exit;
 
-         { left is the next in the list }
-         resulttypepass(left);
+         { right is the next statement in the list }
+         if assigned(right) then
+           resulttypepass(right);
          if codegenerror then
            exit;
       end;
 
+
     function tstatementnode.pass_1 : tnode;
       begin
          result:=nil;
          { no temps over several statements }
+      {$ifndef newra}
          rg.cleartempgen;
-         { right is the statement itself calln assignn or a complex one }
-         firstpass(right);
+      {$endif}
+         { left is the statement itself calln assignn or a complex one }
+         firstpass(left);
          if codegenerror then
            exit;
-         location.loc:=right.location.loc;
-         registers32:=right.registers32;
-         registersfpu:=right.registersfpu;
+         expectloc:=left.expectloc;
+         registers32:=left.registers32;
+         registersfpu:=left.registersfpu;
 {$ifdef SUPPORT_MMX}
-         registersmmx:=right.registersmmx;
+         registersmmx:=left.registersmmx;
 {$endif SUPPORT_MMX}
-         { left is the next in the list }
-         firstpass(left);
+         { right is the next in the list }
+         if assigned(right) then
+           firstpass(right);
          if codegenerror then
            exit;
-         if right.registers32>registers32 then
-           registers32:=right.registers32;
-         if right.registersfpu>registersfpu then
-           registersfpu:=right.registersfpu;
-{$ifdef SUPPORT_MMX}
-         if right.registersmmx>registersmmx then
-           registersmmx:=right.registersmmx;
-{$endif}
       end;
 
 {$ifdef extdebug}
-    procedure tstatementnode.dowrite;
+    procedure tstatementnode._dowrite;
 
       begin
          { can't use inherited dowrite, because that will use the
@@ -301,11 +324,11 @@ implementation
          writeln(',');
          { write the statement }
          writenodeindention:=writenodeindention+'    ';
-         writenode(right);
+         writenode(left);
          writeln(')');
          delete(writenodeindention,1,4);
          { go on with the next statement }
-         writenode(left);
+         writenode(right);
       end;
 {$endif}
 
@@ -313,10 +336,12 @@ implementation
                              TBLOCKNODE
 *****************************************************************************}
 
-    constructor tblocknode.create(l : tnode);
+    constructor tblocknode.create(l : tnode;releasetemp : boolean);
 
       begin
          inherited create(blockn,l);
+         if releasetemp then
+           include(flags,nf_releasetemps);
       end;
 
     function tblocknode.det_resulttype:tnode;
@@ -329,32 +354,37 @@ implementation
          hp:=tstatementnode(left);
          while assigned(hp) do
            begin
-              if assigned(hp.right) then
+              if assigned(hp.left) then
                 begin
                    codegenerror:=false;
-                   resulttypepass(hp.right);
+                   resulttypepass(hp.left);
                    if (not (cs_extsyntax in aktmoduleswitches)) and
-                      assigned(hp.right.resulttype.def) and
-                      not((hp.right.nodetype=calln) and
-                          (tcallnode(hp.right).procdefinition.proctypeoption=potype_constructor)) and
-                      not(is_void(hp.right.resulttype.def)) then
-                     CGMessage(cg_e_illegal_expression);
+                      assigned(hp.left.resulttype.def) and
+                      not((hp.left.nodetype=calln) and
+                          { don't complain when funcretrefnode is set, because then the
+                            value is already used. And also not for constructors }
+                          (assigned(tcallnode(hp.left).funcretrefnode) or
+                           (tcallnode(hp.left).procdefinition.proctypeoption=potype_constructor))) and
+                      not(is_void(hp.left.resulttype.def)) then
+                     CGMessagePos(hp.left.fileinfo,cg_e_illegal_expression);
                    { the resulttype of the block is the last type that is
                      returned. Normally this is a voidtype. But when the
                      compiler inserts a block of multiple statements then the
                      last entry can return a value }
-                   resulttype:=hp.right.resulttype;
+                   resulttype:=hp.left.resulttype;
                 end;
-              hp:=tstatementnode(hp.left);
+              hp:=tstatementnode(hp.right);
            end;
       end;
 
+
     function tblocknode.pass_1 : tnode;
       var
          hp : tstatementnode;
          count : longint;
       begin
          result:=nil;
+         expectloc:=LOC_VOID;
          count:=0;
          hp:=tstatementnode(left);
          while assigned(hp) do
@@ -369,51 +399,54 @@ implementation
                    if {ret_in_acc(aktprocdef.rettype.def) and }
                       (is_ordinal(aktprocdef.rettype.def) or
                        is_smallset(aktprocdef.rettype.def)) and
-                      assigned(hp.left) and
-                      assigned(tstatementnode(hp.left).right) and
-                      (tstatementnode(hp.left).right.nodetype=exitn) and
-                      (hp.right.nodetype=assignn) and
+                      assigned(hp.right) and
+                      assigned(tstatementnode(hp.right).left) and
+                      (tstatementnode(hp.right).left.nodetype=exitn) and
+                      (hp.left.nodetype=assignn) and
                       { !!!! this tbinarynode should be tassignmentnode }
-                      (tbinarynode(hp.right).left.nodetype=funcretn) then
+                      (tbinarynode(hp.left).left.nodetype=funcretn) then
                       begin
-                         if assigned(texitnode(tstatementnode(hp.left).right).left) then
+                         if assigned(texitnode(tstatementnode(hp.right).left).left) then
                            CGMessage(cg_n_inefficient_code)
                          else
                            begin
-                              texitnode(tstatementnode(hp.left).right).left:=tstatementnode(hp.right).right;
-                              tstatementnode(hp.right).right:=nil;
-                              hp.right.free;
-                              hp.right:=nil;
+                              texitnode(tstatementnode(hp.right).left).left:=tassignmentnode(hp.left).right;
+                              tassignmentnode(hp.left).right:=nil;
+                              hp.left.free;
+                              hp.left:=nil;
                            end;
                       end
                    { warning if unreachable code occurs and elimate this }
-                   else if (hp.right.nodetype in
+                   else if (hp.left.nodetype in
                      [exitn,breakn,continuen,goton]) and
                      { statement node (JM) }
-                     assigned(hp.left) and
+                     assigned(hp.right) and
                      { kind of statement! (JM) }
-                     assigned(tstatementnode(hp.left).right) and
-                     (tstatementnode(hp.left).right.nodetype<>labeln) then
+                     assigned(tstatementnode(hp.right).left) and
+                     (tstatementnode(hp.right).left.nodetype<>labeln) then
                      begin
                         { use correct line number }
-                        aktfilepos:=hp.left.fileinfo;
-                        hp.left.free;
-                        hp.left:=nil;
+                        aktfilepos:=hp.right.fileinfo;
+                        hp.right.free;
+                        hp.right:=nil;
                         CGMessage(cg_w_unreachable_code);
                         { old lines }
-                        aktfilepos:=hp.right.fileinfo;
+                        aktfilepos:=hp.left.fileinfo;
                      end;
                 end;
-              if assigned(hp.right) then
+              if assigned(hp.left) then
                 begin
+                {$ifndef newra}
                    rg.cleartempgen;
+                {$endif}
                    codegenerror:=false;
-                   firstpass(hp.right);
+                   firstpass(hp.left);
 
-                   hp.registers32:=hp.right.registers32;
-                   hp.registersfpu:=hp.right.registersfpu;
+                   hp.expectloc:=hp.left.expectloc;
+                   hp.registers32:=hp.left.registers32;
+                   hp.registersfpu:=hp.left.registersfpu;
 {$ifdef SUPPORT_MMX}
-                   hp.registersmmx:=hp.right.registersmmx;
+                   hp.registersmmx:=hp.left.registersmmx;
 {$endif SUPPORT_MMX}
                 end
               else
@@ -427,12 +460,28 @@ implementation
               if hp.registersmmx>registersmmx then
                 registersmmx:=hp.registersmmx;
 {$endif}
-              location.loc:=hp.location.loc;
+              expectloc:=hp.expectloc;
               inc(count);
-              hp:=tstatementnode(hp.left);
+              hp:=tstatementnode(hp.right);
            end;
       end;
 
+{$ifdef state_tracking}
+      function Tblocknode.track_state_pass(exec_known:boolean):boolean;
+
+      var hp:Tstatementnode;
+
+      begin
+        track_state_pass:=false;
+        hp:=Tstatementnode(left);
+        while assigned(hp) do
+            begin
+                if hp.left.track_state_pass(exec_known) then
+                    track_state_pass:=true;
+                hp:=Tstatementnode(hp.right);
+            end;
+      end;
+{$endif state_tracking}
 
 {*****************************************************************************
                              TASMNODE
@@ -452,6 +501,52 @@ implementation
         inherited destroy;
       end;
 
+
+    constructor tasmnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      var
+        hp : tai;
+      begin
+        inherited ppuload(t,ppufile);
+        p_asm:=taasmoutput.create;
+        repeat
+          hp:=ppuloadai(ppufile);
+          if hp=nil then
+           break;
+          p_asm.concat(hp);
+        until false;
+      end;
+
+
+    procedure tasmnode.ppuwrite(ppufile:tcompilerppufile);
+      var
+        hp : tai;
+      begin
+        inherited ppuwrite(ppufile);
+        hp:=tai(p_asm.first);
+        while assigned(hp) do
+         begin
+           ppuwriteai(ppufile,hp);
+           hp:=tai(hp.next);
+         end;
+        { end is marked by a nil }
+        ppuwriteai(ppufile,nil);
+      end;
+
+
+    procedure tasmnode.derefimpl;
+      var
+        hp : tai;
+      begin
+        inherited derefimpl;
+        hp:=tai(p_asm.first);
+        while assigned(hp) do
+         begin
+           hp.derefimpl;
+           hp:=tai(hp.next);
+         end;
+      end;
+
+
     function tasmnode.getcopy: tnode;
       var
         n: tasmnode;
@@ -475,22 +570,25 @@ implementation
     function tasmnode.pass_1 : tnode;
       begin
          result:=nil;
-         procinfo^.flags:=procinfo^.flags or pi_uses_asm;
+         expectloc:=LOC_VOID;
+         procinfo.flags:=procinfo.flags or pi_uses_asm;
       end;
 
+
     function tasmnode.docompare(p: tnode): boolean;
       begin
         { comparing of asmlists is not implemented (JM) }
         docompare := false;
       end;
 
+
 {*****************************************************************************
                           TEMPCREATENODE
 *****************************************************************************}
 
     constructor ttempcreatenode.create(const _restype: ttype; _size: longint; _persistent: boolean);
       begin
-        inherited create(tempn);
+        inherited create(tempcreaten);
         size := _size;
         new(tempinfo);
         fillchar(tempinfo^,sizeof(tempinfo^),0);
@@ -509,17 +607,24 @@ implementation
         fillchar(n.tempinfo^,sizeof(n.tempinfo^),0);
         n.tempinfo^.restype := tempinfo^.restype;
 
+        { when the tempinfo has already a hookoncopy then it is not
+          reset by a tempdeletenode }
+        if assigned(tempinfo^.hookoncopy) then
+          internalerror(200211262);
+
         { signal the temprefs that the temp they point to has been copied, }
         { so that if the refs get copied as well, they can hook themselves }
         { to the copy of the temp                                          }
         tempinfo^.hookoncopy := n.tempinfo;
+        tempinfo^.nextref_set_hookoncopy_nil := false;
 
         result := n;
       end;
 
     function ttempcreatenode.pass_1 : tnode;
       begin
-        result := nil;
+         result := nil;
+         expectloc:=LOC_VOID;
       end;
 
     function ttempcreatenode.det_resulttype: tnode;
@@ -534,7 +639,7 @@ implementation
         result :=
           inherited docompare(p) and
           (ttempcreatenode(p).size = size) and
-          is_equal(ttempcreatenode(p).tempinfo^.restype.def,tempinfo^.restype.def);
+          equal_defs(ttempcreatenode(p).tempinfo^.restype.def,tempinfo^.restype.def);
       end;
 
 {*****************************************************************************
@@ -559,6 +664,7 @@ implementation
         n: ttemprefnode;
       begin
         n := ttemprefnode(inherited getcopy);
+        n.offset := offset;
 
         if assigned(tempinfo^.hookoncopy) then
           { if the temp has been copied, assume it becomes a new }
@@ -566,6 +672,12 @@ implementation
           begin
             { hook the ref to the copied temp }
             n.tempinfo := tempinfo^.hookoncopy;
+            { if we passed a ttempdeletenode that changed the temp }
+            { from a persistent one into a normal one, we must be  }
+            { the last reference (since our parent should free the }
+            { temp (JM)                                            }
+            if (tempinfo^.nextref_set_hookoncopy_nil) then
+              tempinfo^.hookoncopy := nil;
           end
         else
           { if the temp we refer to hasn't been copied, assume }
@@ -579,7 +691,7 @@ implementation
 
     function ttemprefnode.pass_1 : tnode;
       begin
-        location.loc:=LOC_REFERENCE;
+        expectloc:=LOC_REFERENCE;
         result := nil;
       end;
 
@@ -596,16 +708,24 @@ implementation
       begin
         result :=
           inherited docompare(p) and
-          (ttemprefnode(p).tempinfo = tempinfo);
+          (ttemprefnode(p).tempinfo = tempinfo) and
+          (ttemprefnode(p).offset = offset);
       end;
 
+    procedure Ttemprefnode.mark_write;
+
+    begin
+      include(flags,nf_write);
+    end;
+
+
 {*****************************************************************************
                              TEMPDELETENODE
 *****************************************************************************}
 
     constructor ttempdeletenode.create(const temp: ttempcreatenode);
       begin
-        inherited create(temprefn);
+        inherited create(tempdeleten);
         tempinfo := temp.tempinfo;
         release_to_normal := false;
         if not temp.persistent then
@@ -614,7 +734,7 @@ implementation
 
     constructor ttempdeletenode.create_normal_temp(const temp: ttempcreatenode);
       begin
-        inherited create(temprefn);
+        inherited create(tempdeleten);
         tempinfo := temp.tempinfo;
         release_to_normal := true;
       end;
@@ -624,6 +744,7 @@ implementation
         n: ttempdeletenode;
       begin
         n := ttempdeletenode(inherited getcopy);
+        n.release_to_normal := release_to_normal;
 
         if assigned(tempinfo^.hookoncopy) then
           { if the temp has been copied, assume it becomes a new }
@@ -631,6 +752,13 @@ implementation
           begin
             { hook the tempdeletenode to the copied temp }
             n.tempinfo := tempinfo^.hookoncopy;
+            { the temp shall not be used, reset hookoncopy    }
+            { Only if release_to_normal is false, otherwise   }
+            { the temp can still be referenced once more (JM) }
+            if (not release_to_normal) then
+              tempinfo^.hookoncopy:=nil
+            else
+              tempinfo^.nextref_set_hookoncopy_nil := true;
           end
         else
           { if the temp we refer to hasn't been copied, we have a }
@@ -642,7 +770,8 @@ implementation
 
     function ttempdeletenode.pass_1 : tnode;
       begin
-        result := nil;
+         expectloc:=LOC_VOID;
+         result := nil;
       end;
 
     function ttempdeletenode.det_resulttype: tnode;
@@ -675,7 +804,118 @@ begin
 end.
 {
   $Log$
-  Revision 1.22  2002-04-23 19:16:34  peter
+  Revision 1.46  2002-04-25 20:15:39  florian
+    * block nodes within expressions shouldn't release the used registers,
+      fixed using a flag till the new rg is ready
+
+  Revision 1.45  2003/04/23 08:41:34  jonas
+    * fixed ttemprefnode.compare and .getcopy to take offset field into
+      account
+
+  Revision 1.44  2003/04/22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.43  2003/04/21 15:00:22  jonas
+    * fixed tstatementnode.det_resulttype and tststatementnode.pass_1
+    * fixed some getcopy issues with ttemp*nodes
+
+  Revision 1.42  2003/04/17 07:50:24  daniel
+    * Some work on interference graph construction
+
+  Revision 1.41  2003/04/12 14:53:59  jonas
+    * ttempdeletenode.create now sets the nodetype to tempdeleten instead of
+      temprefn
+
+  Revision 1.40  2003/03/17 20:30:46  peter
+    * errornode.mark_write added
+
+  Revision 1.39  2003/01/03 12:15:55  daniel
+    * Removed ifdefs around notifications
+      ifdefs around for loop optimizations remain
+
+  Revision 1.38  2002/11/27 02:37:12  peter
+    * case statement inlining added
+    * fixed inlining of write()
+    * switched statementnode left and right parts so the statements are
+      processed in the correct order when getcopy is used. This is
+      required for tempnodes
+
+  Revision 1.37  2002/11/25 17:43:17  peter
+    * splitted defbase in defutil,symutil,defcmp
+    * merged isconvertable and is_equal into compare_defs(_ext)
+    * made operator search faster by walking the list only once
+
+  Revision 1.36  2002/10/05 15:15:19  peter
+    * don't complain in X- mode for internal generated function calls
+      with funcretrefnode set
+    * give statement error at the correct line position instead of the
+      block begin
+
+  Revision 1.35  2002/09/01 08:01:16  daniel
+   * Removed sets from Tcallnode.det_resulttype
+   + Added read/write notifications of variables. These will be usefull
+     for providing information for several optimizations. For example
+     the value of the loop variable of a for loop does matter is the
+     variable is read after the for loop, but if it's no longer used
+     or written, it doesn't matter and this can be used to optimize
+     the loop code generation.
+
+  Revision 1.34  2002/08/18 20:06:23  peter
+    * inlining is now also allowed in interface
+    * renamed write/load to ppuwrite/ppuload
+    * tnode storing in ppu
+    * nld,ncon,nbas are already updated for storing in ppu
+
+  Revision 1.33  2002/08/17 22:09:44  florian
+    * result type handling in tcgcal.pass_2 overhauled
+    * better tnode.dowrite
+    * some ppc stuff fixed
+
+  Revision 1.32  2002/08/17 09:23:34  florian
+    * first part of procinfo rewrite
+
+  Revision 1.31  2002/08/15 19:10:35  peter
+    * first things tai,tnode storing in ppu
+
+  Revision 1.30  2002/07/20 11:57:53  florian
+    * types.pas renamed to defbase.pas because D6 contains a types
+      unit so this would conflicts if D6 programms are compiled
+    + Willamette/SSE2 instructions to assembler added
+
+  Revision 1.29  2002/07/19 11:41:35  daniel
+  * State tracker work
+  * The whilen and repeatn are now completely unified into whilerepeatn. This
+    allows the state tracker to change while nodes automatically into
+    repeat nodes.
+  * Resulttypepass improvements to the notn. 'not not a' is optimized away and
+    'not(a>b)' is optimized into 'a<=b'.
+  * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
+    by removing the notn and later switchting the true and falselabels. The
+    same is done with 'repeat until not a'.
+
+  Revision 1.28  2002/07/14 18:00:43  daniel
+  + Added the beginning of a state tracker. This will track the values of
+    variables through procedures and optimize things away.
+
+  Revision 1.27  2002/07/01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.26  2002/06/24 12:43:00  jonas
+    * fixed errors found with new -CR code from Peter when cycling with -O2p3r
+
+  Revision 1.25  2002/05/18 13:34:09  peter
+    * readded missing revisions
+
+  Revision 1.24  2002/05/16 19:46:37  carl
+  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+  + try to fix temp allocation (still in ifdef)
+  + generic constructor calls
+  + start of tassembler / tmodulebase class cleanup
+
+  Revision 1.22  2002/04/23 19:16:34  peter
     * add pinline unit that inserts compiler supported functions using
       one or more statements
     * moved finalize and setlength from ninl to pinline
@@ -708,82 +948,4 @@ end.
     - list field removed of the tnode class because it's not used currently
       and can cause hard-to-find bugs
 
-  Revision 1.18  2001/11/02 22:58:01  peter
-    * procsym definition rewrite
-
-  Revision 1.17  2001/09/02 21:12:06  peter
-    * move class of definitions into type section for delphi
-
-  Revision 1.16  2001/08/26 13:36:38  florian
-    * some cg reorganisation
-    * some PPC updates
-
-  Revision 1.15  2001/08/24 13:47:26  jonas
-    * moved "reverseparameters" from ninl.pas to ncal.pas
-    + support for non-persistent temps in ttempcreatenode.create, for use
-      with typeconversion nodes
-
-  Revision 1.14  2001/08/23 14:28:35  jonas
-    + tempcreate/ref/delete nodes (allows the use of temps in the
-      resulttype and first pass)
-    * made handling of read(ln)/write(ln) processor independent
-    * moved processor independent handling for str and reset/rewrite-typed
-      from firstpass to resulttype pass
-    * changed names of helpers in text.inc to be generic for use as
-      compilerprocs + added "iocheck" directive for most of them
-    * reading of ordinals is done by procedures instead of functions
-      because otherwise FPC_IOCHECK overwrote the result before it could
-      be stored elsewhere (range checking still works)
-    * compilerprocs can now be used in the system unit before they are
-      implemented
-    * added note to errore.msg that booleans can't be read using read/readln
-
-  Revision 1.13  2001/08/06 21:40:46  peter
-    * funcret moved from tprocinfo to tprocdef
-
-  Revision 1.12  2001/06/11 17:41:12  jonas
-    * fixed web bug 1501 in conjunction with -Or
-
-  Revision 1.11  2001/05/18 22:31:06  peter
-    * tasmnode.pass_2 is independent of cpu, moved to ncgbas
-    * include ncgbas for independent nodes
-
-  Revision 1.10  2001/04/13 01:22:08  peter
-    * symtable change to classes
-    * range check generation and errors fixed, make cycle DEBUG=1 works
-    * memory leaks fixed
-
-  Revision 1.9  2001/04/02 21:20:30  peter
-    * resulttype rewrite
-
-  Revision 1.8  2001/02/05 20:45:49  peter
-    * fixed buf 1364
-
-  Revision 1.7  2000/12/31 11:14:10  jonas
-    + implemented/fixed docompare() mathods for all nodes (not tested)
-    + nopt.pas, nadd.pas, i386/n386opt.pas: optimized nodes for adding strings
-      and constant strings/chars together
-    * n386add.pas: don't copy temp strings (of size 256) to another temp string
-      when adding
-
-  Revision 1.6  2000/12/25 00:07:26  peter
-    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
-      tlinkedlist objects)
-
-  Revision 1.5  2000/11/29 00:30:31  florian
-    * unused units removed from uses clause
-    * some changes for widestrings
-
-  Revision 1.4  2000/10/31 22:02:47  peter
-    * symtable splitted, no real code changes
-
-  Revision 1.3  2000/10/27 14:57:16  jonas
-    + implementation for tasmnode.getcopy
-
-  Revision 1.2  2000/10/14 21:52:54  peter
-    * fixed memory leaks
-
-  Revision 1.1  2000/10/14 10:14:50  peter
-    * moehrendorf oct 2000 rewrite
-
 }

compiler/ncgbas.pas

@@ -1,6 +1,6 @@
 {
     $Id$
-    Copyright (c) 2000 by Florian Klaempfl
+    Copyright (c) 2000-2002 by Florian Klaempfl
 
     This unit implements some basic nodes
 
@@ -22,7 +22,7 @@
 }
 unit ncgbas;
 
-{$i defines.inc}
+{$i fpcdefs.inc}
 
 interface
 
@@ -63,18 +63,20 @@ interface
     uses
       globtype,systems,
       cutils,verbose,globals,
-      aasm,symsym,
-      cpubase,cpuasm,
+      aasmbase,aasmtai,aasmcpu,symsym,
+      cpubase,
       nflw,pass_2,
-      cga,
-      cgbase,tgobj,rgobj
+      cgbase,cginfo,cgobj,tgobj,rgobj
       ;
+
 {*****************************************************************************
                                  TNOTHING
 *****************************************************************************}
 
     procedure tcgnothingnode.pass_2;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          { avoid an abstract rte }
       end;
 
@@ -85,19 +87,23 @@ interface
 
     procedure tcgstatementnode.pass_2;
       var
-         hp : tnode;
+         hp : tstatementnode;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          hp:=self;
          while assigned(hp) do
           begin
-            if assigned(tstatementnode(hp).right) then
+            if assigned(hp.left) then
              begin
+             {$ifndef newra}
                rg.cleartempgen;
-               secondpass(tstatementnode(hp).right);
+             {$endif newra}
+               secondpass(hp.left);
                { Compiler inserted blocks can return values }
-               location_copy(location,tstatementnode(hp).right.location);
+               location_copy(hp.location,hp.left.location);
              end;
-            hp:=tstatementnode(hp).left;
+            hp:=tstatementnode(hp.right);
           end;
       end;
 
@@ -110,21 +116,14 @@ interface
 
       procedure ReLabel(var p:tasmsymbol);
         begin
-          if p.proclocal then
+          { Only relabel local tasmlabels }
+          if (p.defbind = AB_LOCAL) and
+             (p is tasmlabel) then
            begin
              if not assigned(p.altsymbol) then
-              begin
-                { generatealtsymbol will also increase the refs }
-                p.GenerateAltSymbol;
-                UsedAsmSymbolListInsert(p);
-              end
-             else
-              begin
-                { increase the refs, they will be decreased when the
-                  asmnode is destroyed }
-                inc(p.refs);
-              end;
+               objectlibrary.GenerateAltSymbol(p);
              p:=p.altsymbol;
+             p.increfs;
            end;
         end;
 
@@ -134,9 +133,11 @@ interface
         i : longint;
         skipnode : boolean;
       begin
+         location_reset(location,LOC_VOID,OS_NO);
+
          if inlining_procedure then
            begin
-             CreateUsedAsmSymbolList;
+             objectlibrary.CreateUsedAsmSymbolList;
              localfixup:=aktprocdef.localst.address_fixup;
              parafixup:=aktprocdef.parast.address_fixup;
              hp:=tai(p_asm.first);
@@ -159,7 +160,11 @@ interface
                      begin
                        { remove cached insentry, because the new code can
                          require an other less optimized instruction }
+{$ifdef i386}
+{$ifndef NOAG386BIN}
                        taicpu(hp2).ResetPass1;
+{$endif}
+{$endif}
                        { fixup the references }
                        for i:=1 to taicpu(hp2).ops do
                         begin
@@ -200,8 +205,8 @@ interface
                 hp:=tai(hp.next);
               end;
              { restore used symbols }
-             UsedAsmSymbolListResetAltSym;
-             DestroyUsedAsmSymbolList;
+             objectlibrary.UsedAsmSymbolListResetAltSym;
+             objectlibrary.DestroyUsedAsmSymbolList;
            end
          else
            begin
@@ -212,8 +217,6 @@ interface
              else
                exprasmList.concatlist(p_asm);
            end;
-         if not (nf_object_preserved in flags) then
-           maybe_loadself;
        end;
 
 
@@ -222,13 +225,29 @@ interface
 *****************************************************************************}
 
     procedure tcgblocknode.pass_2;
+      var
+        hp : tstatementnode;
       begin
+        location_reset(location,LOC_VOID,OS_NO);
+
         { do second pass on left node }
         if assigned(left) then
          begin
-           secondpass(left);
-           { Compiler inserted blocks can return values }
-           location_copy(location,left.location);
+           hp:=tstatementnode(left);
+           while assigned(hp) do
+            begin
+              if assigned(hp.left) then
+               begin
+               {$ifndef newra}
+                 if nf_releasetemps in flags then
+                   rg.cleartempgen;
+               {$endif newra}
+                 secondpass(hp.left);
+                 location_copy(hp.location,hp.left.location);
+               end;
+              location_copy(location,hp.location);
+              hp:=tstatementnode(hp.right);
+            end;
          end;
       end;
 
@@ -237,16 +256,21 @@ interface
 *****************************************************************************}
 
     procedure tcgtempcreatenode.pass_2;
+      var
+        temptype : ttemptype;
       begin
+        location_reset(location,LOC_VOID,OS_NO);
+
         { if we're secondpassing the same tcgtempcreatenode twice, we have a bug }
         if tempinfo^.valid then
           internalerror(200108222);
 
         { get a (persistent) temp }
         if persistent then
-          tg.gettempofsizereferencepersistant(exprasmlist,size,tempinfo^.ref)
+          temptype:=tt_persistant
         else
-          tg.gettempofsizereference(exprasmlist,size,tempinfo^.ref);
+          temptype:=tt_normal;
+        tg.GetTemp(exprasmlist,size,temptype,tempinfo^.ref);
         tempinfo^.valid := true;
       end;
 
@@ -272,10 +296,12 @@ interface
 
     procedure tcgtempdeletenode.pass_2;
       begin
+        location_reset(location,LOC_VOID,OS_NO);
+
         if release_to_normal then
-          tg.persistanttemptonormal(tempinfo^.ref.offset)
+          tg.ChangeTempType(exprasmlist,tempinfo^.ref,tt_normal)
         else
-          tg.ungetpersistanttempreference(exprasmlist,tempinfo^.ref);
+          tg.UnGetTemp(exprasmlist,tempinfo^.ref);
       end;
 
 
@@ -290,7 +316,102 @@ begin
 end.
 {
   $Log$
-  Revision 1.14  2002-04-23 19:16:34  peter
+  Revision 1.32  2002-04-25 20:15:39  florian
+    * block nodes within expressions shouldn't release the used registers,
+      fixed using a flag till the new rg is ready
+
+  Revision 1.31  2003/04/22 23:50:22  peter
+    * firstpass uses expectloc
+    * checks if there are differences between the expectloc and
+      location.loc from secondpass in EXTDEBUG
+
+  Revision 1.30  2003/04/17 07:50:24  daniel
+    * Some work on interference graph construction
+
+  Revision 1.29  2003/03/28 19:16:56  peter
+    * generic constructor working for i386
+    * remove fixed self register
+    * esi added as address register for i386
+
+  Revision 1.28  2002/11/27 15:33:19  peter
+    * fixed relabeling to relabel only tasmlabel (formerly proclocal)
+
+  Revision 1.27  2002/11/27 02:37:13  peter
+    * case statement inlining added
+    * fixed inlining of write()
+    * switched statementnode left and right parts so the statements are
+      processed in the correct order when getcopy is used. This is
+      required for tempnodes
+
+  Revision 1.26  2002/11/17 16:31:56  carl
+    * memory optimization (3-4%) : cleanup of tai fields,
+       cleanup of tdef and tsym fields.
+    * make it work for m68k
+
+  Revision 1.25  2002/11/15 16:29:30  peter
+    * made tasmsymbol.refs private (merged)
+
+  Revision 1.24  2002/11/15 01:58:51  peter
+    * merged changes from 1.0.7 up to 04-11
+      - -V option for generating bug report tracing
+      - more tracing for option parsing
+      - errors for cdecl and high()
+      - win32 import stabs
+      - win32 records<=8 are returned in eax:edx (turned off by default)
+      - heaptrc update
+      - more info for temp management in .s file with EXTDEBUG
+
+  Revision 1.23  2002/08/23 16:14:48  peter
+    * tempgen cleanup
+    * tt_noreuse temp type added that will be used in genentrycode
+
+  Revision 1.22  2002/08/11 14:32:26  peter
+    * renamed current_library to objectlibrary
+
+  Revision 1.21  2002/08/11 13:24:11  peter
+    * saving of asmsymbols in ppu supported
+    * asmsymbollist global is removed and moved into a new class
+      tasmlibrarydata that will hold the info of a .a file which
+      corresponds with a single module. Added librarydata to tmodule
+      to keep the library info stored for the module. In the future the
+      objectfiles will also be stored to the tasmlibrarydata class
+    * all getlabel/newasmsymbol and friends are moved to the new class
+
+  Revision 1.20  2002/07/01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.19  2002/05/18 13:34:09  peter
+    * readded missing revisions
+
+  Revision 1.18  2002/05/16 19:46:37  carl
+  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+  + try to fix temp allocation (still in ifdef)
+  + generic constructor calls
+  + start of tassembler / tmodulebase class cleanup
+
+  Revision 1.16  2002/05/13 19:54:37  peter
+    * removed n386ld and n386util units
+    * maybe_save/maybe_restore added instead of the old maybe_push
+
+  Revision 1.15  2002/05/12 16:53:07  peter
+    * moved entry and exitcode to ncgutil and cgobj
+    * foreach gets extra argument for passing local data to the
+      iterator function
+    * -CR checks also class typecasts at runtime by changing them
+      into as
+    * fixed compiler to cycle with the -CR option
+    * fixed stabs with elf writer, finally the global variables can
+      be watched
+    * removed a lot of routines from cga unit and replaced them by
+      calls to cgobj
+    * u32bit-s32bit updates for and,or,xor nodes. When one element is
+      u32bit then the other is typecasted also to u32bit without giving
+      a rangecheck warning/error.
+    * fixed pascal calling method with reversing also the high tree in
+      the parast, detected by tcalcst3 test
+
+  Revision 1.14  2002/04/23 19:16:34  peter
     * add pinline unit that inserts compiler supported functions using
       one or more statements
     * moved finalize and setlength from ninl to pinline
@@ -323,52 +444,4 @@ end.
     - list field removed of the tnode class because it's not used currently
       and can cause hard-to-find bugs
 
-  Revision 1.10  2001/12/31 16:54:14  peter
-    * fixed inline crash with assembler routines
-
-  Revision 1.9  2001/11/02 22:58:01  peter
-    * procsym definition rewrite
-
-  Revision 1.8  2001/10/25 21:22:35  peter
-    * calling convention rewrite
-
-  Revision 1.7  2001/08/26 13:36:39  florian
-    * some cg reorganisation
-    * some PPC updates
-
-  Revision 1.6  2001/08/24 13:47:27  jonas
-    * moved "reverseparameters" from ninl.pas to ncal.pas
-    + support for non-persistent temps in ttempcreatenode.create, for use
-      with typeconversion nodes
-
-  Revision 1.5  2001/08/23 14:28:35  jonas
-    + tempcreate/ref/delete nodes (allows the use of temps in the
-      resulttype and first pass)
-    * made handling of read(ln)/write(ln) processor independent
-    * moved processor independent handling for str and reset/rewrite-typed
-      from firstpass to resulttype pass
-    * changed names of helpers in text.inc to be generic for use as
-      compilerprocs + added "iocheck" directive for most of them
-    * reading of ordinals is done by procedures instead of functions
-      because otherwise FPC_IOCHECK overwrote the result before it could
-      be stored elsewhere (range checking still works)
-    * compilerprocs can now be used in the system unit before they are
-      implemented
-    * added note to errore.msg that booleans can't be read using read/readln
-
-  Revision 1.4  2001/06/02 19:22:15  peter
-    * refs count for relabeled asmsymbols fixed
-
-  Revision 1.3  2001/05/18 22:31:06  peter
-    * tasmnode.pass_2 is independent of cpu, moved to ncgbas
-    * include ncgbas for independent nodes
-
-  Revision 1.2  2001/04/13 01:22:08  peter
-    * symtable change to classes
-    * range check generation and errors fixed, make cycle DEBUG=1 works
-    * memory leaks fixed
-
-  Revision 1.1  2000/10/14 10:14:50  peter
-    * moehrendorf oct 2000 rewrite
-
 }

compiler/pinline.pas

@@ -1,6 +1,6 @@
 {
     $Id$
-    Copyright (c) 1998-2001 by Florian Klaempfl
+    Copyright (c) 1998-2002 by Florian Klaempfl
 
     Generates nodes for routines that need compiler support
 
@@ -22,7 +22,7 @@
 }
 unit pinline;
 
-{$i defines.inc}
+{$i fpcdefs.inc}
 
 interface
 
@@ -37,6 +37,7 @@ interface
 
     function inline_setlength : tnode;
     function inline_finalize : tnode;
+    function inline_copy : tnode;
 
 
 implementation
@@ -49,9 +50,9 @@ implementation
        cutils,
        { global }
        globtype,tokens,verbose,
-       systems,widestr,
+       systems,
        { symtable }
-       symconst,symbase,symdef,symsym,symtable,types,
+       symconst,symdef,symsym,symtable,defutil,
        { pass 1 }
        pass_1,htypechk,
        nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
@@ -169,6 +170,15 @@ implementation
                 { we need the real called method }
                 { rg.cleartempgen;}
                 do_resulttypepass(p2);
+
+                if p2.nodetype<>calln then
+                  begin
+                    if is_new then
+                      CGMessage(parser_e_expr_have_to_be_constructor_call)
+                    else
+                      CGMessage(parser_e_expr_have_to_be_destructor_call);
+                  end;
+
                 if not codegenerror then
                  begin
                    if is_new then
@@ -211,7 +221,7 @@ implementation
 
                   { create statements with call to getmem+initialize or
                     finalize+freemem }
-                  new_dispose_statement:=internalstatements(newstatement);
+                  new_dispose_statement:=internalstatements(newstatement,true);
 
                   if is_new then
                    begin
@@ -221,7 +231,7 @@ implementation
 
                      { create call to fpc_getmem }
                      para := ccallparanode.create(cordconstnode.create
-                         (tpointerdef(p.resulttype.def).pointertype.def.size,s32bittype),nil);
+                         (tpointerdef(p.resulttype.def).pointertype.def.size,s32bittype,true),nil);
                      addstatement(newstatement,cassignmentnode.create(
                          ctemprefnode.create(temp),
                          ccallnode.createintern('fpc_getmem',para)));
@@ -297,7 +307,7 @@ implementation
               Message(parser_w_use_extended_syntax_for_objects);
 
             { create statements with call to getmem+initialize }
-            newblock:=internalstatements(newstatement);
+            newblock:=internalstatements(newstatement,true);
 
             { create temp for result }
             temp := ctempcreatenode.create(p1.resulttype,p1.resulttype.def.size,true);
@@ -305,7 +315,7 @@ implementation
 
             { create call to fpc_getmem }
             para := ccallparanode.create(cordconstnode.create
-                (tpointerdef(p1.resulttype.def).pointertype.def.size,s32bittype),nil);
+                (tpointerdef(p1.resulttype.def).pointertype.def.size,s32bittype,true),nil);
             addstatement(newstatement,cassignmentnode.create(
                 ctemprefnode.create(temp),
                 ccallnode.createintern('fpc_getmem',para)));
@@ -455,7 +465,7 @@ implementation
          begin
             { create statements with call initialize the arguments and
               call fpc_dynarr_setlength }
-            newblock:=internalstatements(newstatement);
+            newblock:=internalstatements(newstatement,true);
 
             { get temp for array of lengths }
             temp := ctempcreatenode.create(s32bittype,counter*s32bittype.def.size,true);
@@ -480,7 +490,7 @@ implementation
             npara:=ccallparanode.create(caddrnode.create
                       (ctemprefnode.create(temp)),
                    ccallparanode.create(cordconstnode.create
-                      (counter,s32bittype),
+                      (counter,s32bittype,true),
                    ccallparanode.create(caddrnode.create
                       (crttinode.create(tstoreddef(destppn.resulttype.def),initrtti)),
                    ccallparanode.create(ctypeconvnode.create_explicit(destppn,voidpointertype),nil))));
@@ -536,7 +546,7 @@ implementation
             end;
            { create call to fpc_finalize_array }
            npara:=ccallparanode.create(cordconstnode.create
-                     (destppn.left.resulttype.def.size,s32bittype),
+                     (destppn.left.resulttype.def.size,s32bittype,true),
                   ccallparanode.create(ctypeconvnode.create
                      (ppn.left,s32bittype),
                   ccallparanode.create(caddrnode.create
@@ -562,10 +572,168 @@ implementation
         result:=newblock;
       end;
 
+
+    function inline_copy : tnode;
+      var
+        copynode,
+        lowppn,
+        highppn,
+        npara,
+        paras   : tnode;
+        temp    : ttempcreatenode;
+        ppn     : tcallparanode;
+        paradef : tdef;
+        counter : integer;
+        newstatement : tstatementnode;
+      begin
+        { for easy exiting if something goes wrong }
+        result := cerrornode.create;
+
+        consume(_LKLAMMER);
+        paras:=parse_paras(false,false);
+        consume(_RKLAMMER);
+        if not assigned(paras) then
+         begin
+           CGMessage(parser_e_wrong_parameter_size);
+           exit;
+         end;
+
+        { determine copy function to use based on the first argument,
+          also count the number of arguments in this loop }
+        counter:=1;
+        ppn:=tcallparanode(paras);
+        while assigned(ppn.right) do
+         begin
+           inc(counter);
+           ppn:=tcallparanode(ppn.right);
+         end;
+        paradef:=ppn.left.resulttype.def;
+        if is_ansistring(paradef) then
+          copynode:=ccallnode.createintern('fpc_ansistr_copy',paras)
+        else
+         if is_widestring(paradef) then
+           copynode:=ccallnode.createintern('fpc_widestr_copy',paras)
+        else
+         if is_char(paradef) then
+           copynode:=ccallnode.createintern('fpc_char_copy',paras)
+        else
+         if is_dynamic_array(paradef) then
+          begin
+            { Only allow 1 or 3 arguments }
+            if (counter<>1) and (counter<>3) then
+             begin
+               CGMessage(parser_e_wrong_parameter_size);
+               exit;
+             end;
+
+            { create statements with call }
+            copynode:=internalstatements(newstatement,true);
+
+            if (counter=3) then
+             begin
+               highppn:=tcallparanode(paras).left.getcopy;
+               lowppn:=tcallparanode(tcallparanode(paras).right).left.getcopy;
+             end
+            else
+             begin
+               { use special -1,-1 argument to copy the whole array }
+               highppn:=cordconstnode.create(-1,s32bittype,false);
+               lowppn:=cordconstnode.create(-1,s32bittype,false);
+             end;
+
+            { create temp for result, we've to use a temp because a dynarray
+              type is handled differently from a pointer so we can't
+              use createinternres() and a function }
+            temp := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,true);
+            addstatement(newstatement,temp);
+
+            { create call to fpc_dynarray_copy }
+            npara:=ccallparanode.create(highppn,
+                   ccallparanode.create(lowppn,
+                   ccallparanode.create(caddrnode.create
+                      (crttinode.create(tstoreddef(ppn.left.resulttype.def),initrtti)),
+                   ccallparanode.create
+                      (ctypeconvnode.create_explicit(ppn.left,voidpointertype),
+                   ccallparanode.create
+                      (ctemprefnode.create(temp),nil)))));
+            addstatement(newstatement,ccallnode.createintern('fpc_dynarray_copy',npara));
+
+            { convert the temp to normal and return the reference to the
+              created temp, and convert the type of the temp to the dynarray type }
+            addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
+            addstatement(newstatement,ctypeconvnode.create_explicit(ctemprefnode.create(temp),ppn.left.resulttype));
+
+            ppn.left:=nil;
+            paras.free;
+          end
+        else
+         begin
+           { generic fallback that will give an error if a wrong
+             type is passed }
+           copynode:=ccallnode.createintern('fpc_shortstr_copy',paras)
+         end;
+
+        result.free;
+        result:=copynode;
+      end;
+
 end.
 {
   $Log$
-  Revision 1.1  2002-04-23 19:16:35  peter
+  Revision 1.12  2002-04-25 20:15:40  florian
+    * block nodes within expressions shouldn't release the used registers,
+      fixed using a flag till the new rg is ready
+
+  Revision 1.11  2002/11/26 22:59:09  peter
+    * fix Copy(array,x,y)
+
+  Revision 1.10  2002/11/25 17:43:22  peter
+    * splitted defbase in defutil,symutil,defcmp
+    * merged isconvertable and is_equal into compare_defs(_ext)
+    * made operator search faster by walking the list only once
+
+  Revision 1.9  2002/10/29 10:01:22  pierre
+   * fix crash report as webbug 2174
+
+  Revision 1.8  2002/10/02 18:20:52  peter
+    * Copy() is now internal syssym that calls compilerprocs
+
+  Revision 1.7  2002/09/07 12:16:03  carl
+    * second part bug report 1996 fix, testrange in cordconstnode
+      only called if option is set (also make parsing a tiny faster)
+
+  Revision 1.6  2002/07/20 11:57:56  florian
+    * types.pas renamed to defbase.pas because D6 contains a types
+      unit so this would conflicts if D6 programms are compiled
+    + Willamette/SSE2 instructions to assembler added
+
+  Revision 1.5  2002/05/18 13:34:12  peter
+    * readded missing revisions
+
+  Revision 1.4  2002/05/16 19:46:43  carl
+  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+  + try to fix temp allocation (still in ifdef)
+  + generic constructor calls
+  + start of tassembler / tmodulebase class cleanup
+
+  Revision 1.2  2002/05/12 16:53:09  peter
+    * moved entry and exitcode to ncgutil and cgobj
+    * foreach gets extra argument for passing local data to the
+      iterator function
+    * -CR checks also class typecasts at runtime by changing them
+      into as
+    * fixed compiler to cycle with the -CR option
+    * fixed stabs with elf writer, finally the global variables can
+      be watched
+    * removed a lot of routines from cga unit and replaced them by
+      calls to cgobj
+    * u32bit-s32bit updates for and,or,xor nodes. When one element is
+      u32bit then the other is typecasted also to u32bit without giving
+      a rangecheck warning/error.
+    * fixed pascal calling method with reversing also the high tree in
+      the parast, detected by tcalcst3 test
+
+  Revision 1.1  2002/04/23 19:16:35  peter
     * add pinline unit that inserts compiler supported functions using
       one or more statements
     * moved finalize and setlength from ninl to pinline

compiler/pstatmnt.pas

@@ -1,6 +1,6 @@
 {
     $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
+    Copyright (c) 1998-2002 by Florian Klaempfl
 
     Does the parsing of the statements
 
@@ -22,7 +22,7 @@
 }
 unit pstatmnt;
 
-{$i defines.inc}
+{$i fpcdefs.inc}
 
 interface
     uses
@@ -42,11 +42,12 @@ implementation
        cutils,
        { global }
        globtype,globals,verbose,
-       systems,cpuinfo,cpuasm,
+       systems,cpuinfo,
        { aasm }
-       cpubase,aasm,
+       cpubase,aasmbase,aasmtai,aasmcpu,
        { symtable }
-       symconst,symbase,symtype,symdef,symsym,symtable,types,
+       symconst,symbase,symtype,symdef,symsym,symtable,defutil,defcmp,
+       paramgr,
        { pass 1 }
        pass_1,htypechk,
        nbas,nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,
@@ -54,7 +55,9 @@ implementation
        scanner,
        pbase,pexpr,
        { codegen }
-       rgobj,cgbase
+       tgobj,rgobj,cgbase
+       ,ncgutil
+       ,radirect
 {$ifdef i386}
   {$ifndef NoRa386Int}
        ,ra386int
@@ -62,19 +65,9 @@ implementation
   {$ifndef NoRa386Att}
        ,ra386att
   {$endif NoRa386Att}
-  {$ifndef NoRa386Dir}
-       ,ra386dir
-  {$endif NoRa386Dir}
+{$else}
+       ,rasm
 {$endif i386}
-{$ifdef m68k}
-  {$ifndef NoRa68kMot}
-       ,ra68kmot
-  {$endif NoRa68kMot}
-{$endif m68k}
-       { codegen }
-{$ifdef newcg}
-       ,cgbase
-{$endif newcg}
        ;
 
 
@@ -112,20 +105,20 @@ implementation
            begin
               if first=nil then
                 begin
-                   last:=cstatementnode.create(nil,statement);
+                   last:=cstatementnode.create(statement,nil);
                    first:=last;
                 end
               else
                 begin
-                   last.left:=cstatementnode.create(nil,statement);
-                   last:=tstatementnode(last.left);
+                   last.right:=cstatementnode.create(statement,nil);
+                   last:=tstatementnode(last.right);
                 end;
               if not try_to_consume(_SEMICOLON) then
                 break;
               consume_emptystats;
            end;
          consume(_END);
-         statements_til_end:=cblocknode.create(first);
+         statements_til_end:=cblocknode.create(first,true);
       end;
 
 
@@ -179,7 +172,7 @@ implementation
            hcaselabel^.greater:=nil;
            hcaselabel^.statement:=aktcaselabel;
            hcaselabel^.firstlabel:=first;
-           getlabel(hcaselabel^._at);
+           objectlibrary.getlabel(hcaselabel^._at);
            hcaselabel^._low:=l;
            hcaselabel^._high:=h;
            insertlabel(root);
@@ -194,7 +187,9 @@ implementation
          consume(_CASE);
          caseexpr:=comp_expr(true);
        { determines result type }
+       {$ifndef newra}
          rg.cleartempgen;
+       {$endif}
          do_resulttypepass(caseexpr);
          casedeferror:=false;
          casedef:=caseexpr.resulttype.def;
@@ -204,7 +199,7 @@ implementation
             CGMessage(type_e_ordinal_expr_expected);
             { create a correct tree }
             caseexpr.free;
-            caseexpr:=cordconstnode.create(0,u32bittype);
+            caseexpr:=cordconstnode.create(0,u32bittype,false);
             { set error flag so no rangechecks are done }
             casedeferror:=true;
           end;
@@ -214,7 +209,7 @@ implementation
          root:=nil;
          instruc:=nil;
          repeat
-           getlabel(aktcaselabel);
+           objectlibrary.getlabel(aktcaselabel);
            firstlabel:=true;
 
            { maybe an instruction has more case labels }
@@ -281,13 +276,13 @@ implementation
            p:=clabelnode.createcase(aktcaselabel,statement);
 
            { concats instruction }
-           instruc:=cstatementnode.create(instruc,p);
+           instruc:=cstatementnode.create(p,instruc);
 
-           if not((token=_ELSE) or (token=_OTHERWISE) or (token=_END)) then
+           if not(token in [_ELSE,_OTHERWISE,_END]) then
              consume(_SEMICOLON);
-         until (token=_ELSE) or (token=_OTHERWISE) or (token=_END);
+         until (token in [_ELSE,_OTHERWISE,_END]);
 
-         if (token=_ELSE) or (token=_OTHERWISE) then
+         if (token in [_ELSE,_OTHERWISE]) then
            begin
               if not try_to_consume(_ELSE) then
                 consume(_OTHERWISE);
@@ -322,13 +317,13 @@ implementation
            begin
               if first=nil then
                 begin
-                   last:=cstatementnode.create(nil,statement);
+                   last:=cstatementnode.create(statement,nil);
                    first:=last;
                 end
               else
                 begin
-                   tstatementnode(last).left:=cstatementnode.create(nil,statement);
-                   last:=tstatementnode(last).left;
+                   tstatementnode(last).right:=cstatementnode.create(statement,nil);
+                   last:=tstatementnode(last).right;
                 end;
               if not try_to_consume(_SEMICOLON) then
                 break;
@@ -337,9 +332,9 @@ implementation
          consume(_UNTIL);
          dec(statement_level);
 
-         first:=cblocknode.create(first);
+         first:=cblocknode.create(first,true);
          p_e:=comp_expr(true);
-         repeat_statement:=genloopnode(repeatn,p_e,first,nil,false);
+         repeat_statement:=genloopnode(whilerepeatn,p_e,first,nil,true);
       end;
 
 
@@ -353,7 +348,7 @@ implementation
          p_e:=comp_expr(true);
          consume(_DO);
          p_a:=statement;
-         while_statement:=genloopnode(whilen,p_e,p_a,nil,false);
+         while_statement:=genloopnode(whilerepeatn,p_e,p_a,nil,false);
       end;
 
 
@@ -495,7 +490,7 @@ implementation
          paddr:=nil;
          pframe:=nil;
          consume(_RAISE);
-         if not(token in [_SEMICOLON,_END]) then
+         if not(token in endtokens) then
            begin
               { object }
               pobj:=comp_expr(true);
@@ -531,7 +526,7 @@ implementation
          oldaktexceptblock: integer;
 
       begin
-         procinfo^.flags:=procinfo^.flags or pi_uses_exceptions;
+         procinfo.flags:=procinfo.flags or pi_uses_exceptions;
 
          p_default:=nil;
          p_specific:=nil;
@@ -548,19 +543,19 @@ implementation
            begin
               if first=nil then
                 begin
-                   last:=cstatementnode.create(nil,statement);
+                   last:=cstatementnode.create(statement,nil);
                    first:=last;
                 end
               else
                 begin
-                   tstatementnode(last).left:=cstatementnode.create(nil,statement);
-                   last:=tstatementnode(last).left;
+                   tstatementnode(last).right:=cstatementnode.create(statement,nil);
+                   last:=tstatementnode(last).right;
                 end;
               if not try_to_consume(_SEMICOLON) then
                 break;
               consume_emptystats;
            end;
-         p_try_block:=cblocknode.create(first);
+         p_try_block:=cblocknode.create(first,true);
 
          if try_to_consume(_FINALLY) then
            begin
@@ -690,19 +685,18 @@ implementation
                      if not try_to_consume(_SEMICOLON) then
                         break;
                      consume_emptystats;
-                   until (token=_END) or (token=_ELSE);
-                   if token=_ELSE then
-                     { catch the other exceptions }
+                   until (token in [_END,_ELSE]);
+                   if try_to_consume(_ELSE) then
                      begin
-                        consume(_ELSE);
-                        p_default:=statements_til_end;
+                       { catch the other exceptions }
+                       p_default:=statements_til_end;
                      end
                    else
                      consume(_END);
                 end
               else
-                { catch all exceptions }
                 begin
+                   { catch all exceptions }
                    p_default:=statements_til_end;
                 end;
               dec(statement_level);
@@ -714,34 +708,13 @@ implementation
       end;
 
 
-    function exit_statement : tnode;
-
-      var
-         p : tnode;
-
-      begin
-         consume(_EXIT);
-         if try_to_consume(_LKLAMMER) then
-           begin
-              p:=comp_expr(true);
-              consume(_RKLAMMER);
-              if (block_type=bt_except) then
-                Message(parser_e_exit_with_argument_not__possible);
-              if is_void(aktprocdef.rettype.def) then
-                Message(parser_e_void_function);
-           end
-         else
-           p:=nil;
-         p:=cexitnode.create(p);
-         do_resulttypepass(p);
-         exit_statement:=p;
-      end;
-
-
     function _asm_statement : tnode;
       var
         asmstat : tasmnode;
-        Marker : tai;
+        Marker  : tai;
+        r       : tregister;
+        found   : boolean;
+        hs      : string;
       begin
          Inside_asm_statement:=true;
          case aktasmmode of
@@ -756,8 +729,11 @@ implementation
            asmmode_i386_intel:
              asmstat:=tasmnode(ra386int.assemble);
   {$endif NoRA386Int}
-  {$ifndef NoRA386Dir}
-           asmmode_i386_direct:
+{$else not i386}
+           asmmode_standard:
+             asmstat:=tasmnode(rasm.assemble);
+{$endif i386}
+           asmmode_direct:
              begin
                if not target_asm.allowdirect then
                  Message(parser_f_direct_assembler_not_allowed);
@@ -767,16 +743,9 @@ implementation
                     Message(parser_w_inlining_disabled);
                     aktprocdef.proccalloption:=pocall_fpccall;
                  End;
-               asmstat:=tasmnode(ra386dir.assemble);
+               asmstat:=tasmnode(radirect.assemble);
              end;
-  {$endif NoRA386Dir}
-{$endif}
-{$ifdef m68k}
-  {$ifndef NoRA68kMot}
-           asmmode_m68k_mot:
-             asmstat:=tasmnode(ra68kmot.assemble);
-  {$endif NoRA68kMot}
-{$endif}
+
          else
            Message(parser_f_assembler_reader_not_supported);
          end;
@@ -787,71 +756,34 @@ implementation
          { END is read }
          if try_to_consume(_LECKKLAMMER) then
            begin
-              { it's possible to specify the modified registers }
-              include(asmstat.flags,nf_object_preserved);
-              if token<>_RECKKLAMMER then
+             if token<>_RECKKLAMMER then
+              begin
                 repeat
-                { uppercase, because it's a CSTRING }
-                  uppervar(pattern);
-{$ifdef i386}
-                  if pattern='EAX' then
-                    include(rg.usedinproc,R_EAX)
-                  else if pattern='EBX' then
-                    include(rg.usedinproc,R_EBX)
-                  else if pattern='ECX' then
-                    include(rg.usedinproc,R_ECX)
-                  else if pattern='EDX' then
-                    include(rg.usedinproc,R_EDX)
-                  else if pattern='ESI' then
+                  { it's possible to specify the modified registers }
+                  hs:=upper(pattern);
+                  found:=false;
+                  for r.enum:=firstreg to lastreg do
+                   if hs=upper(std_reg2str[r.enum]) then
                     begin
-                       include(rg.usedinproc,R_ESI);
-                       exclude(asmstat.flags,nf_object_preserved);
-                    end
-                  else if pattern='EDI' then
-                    include(rg.usedinproc,R_EDI)
-{$endif i386}
-{$ifdef m68k}
-                  if pattern='D0' then
-                    include(rg.usedinproc,R_D0)
-                  else if pattern='D1' then
-                    include(rg.usedinproc,R_D1)
-                  else if pattern='D2' then
-                    include(rg.usedinproc,R_D2)
-                  else if pattern='D3' then
-                    include(rg.usedinproc,R_D3)
-                  else if pattern='D4' then
-                    include(rg.usedinproc,R_D4)
-                  else if pattern='D5' then
-                    include(rg.usedinproc,R_D5)
-                  else if pattern='D6' then
-                    include(rg.usedinproc,R_D6)
-                  else if pattern='D7' then
-                    include(rg.usedinproc,R_D7)
-                  else if pattern='A0' then
-                    include(rg.usedinproc,R_A0)
-                  else if pattern='A1' then
-                    include(rg.usedinproc,R_A1)
-                  else if pattern='A2' then
-                    include(rg.usedinproc,R_A2)
-                  else if pattern='A3' then
-                    include(rg.usedinproc,R_A3)
-                  else if pattern='A4' then
-                    include(rg.usedinproc,R_A4)
-                  else if pattern='A5' then
-                    include(rg.usedinproc,R_A5)
-{$endif m68k}
-{$ifdef powerpc}
-                  if pattern<>'' then
-                    internalerror(200108251)
-{$endif powerpc}
-                  else consume(_RECKKLAMMER);
+                      include(rg.usedinproc,r.enum);
+                      include(rg.usedbyproc,r.enum);
+                      found:=true;
+                      break;
+                    end;
+                  if not(found) then
+                    Message(asmr_e_invalid_register);
                   consume(_CSTRING);
                   if not try_to_consume(_COMMA) then
                     break;
                 until false;
-              consume(_RECKKLAMMER);
+              end;
+             consume(_RECKKLAMMER);
            end
-         else rg.usedinproc := ALL_REGISTERS;
+         else
+           begin
+              rg.usedbyproc := ALL_REGISTERS;
+              rg.usedinproc := ALL_REGISTERS;
+           end;
 
          { mark the start and the end of the assembler block
            this is needed for the optimizer }
@@ -949,8 +881,6 @@ implementation
                 consume(_FAIL);
                 code:=cfailnode.create;
              end;
-           _EXIT :
-             code:=exit_statement;
            _ASM :
              code:=_asm_statement;
            _EOF :
@@ -992,7 +922,7 @@ implementation
              { with a separate statement for each read/write operation (JM)    }
              { the same is true for val() if the third parameter is not 32 bit }
              if not(p.nodetype in [nothingn,calln,assignn,breakn,inlinen,
-                                   continuen,labeln,blockn]) then
+                                   continuen,labeln,blockn,exitn]) then
                Message(cg_e_illegal_expression);
 
              { specify that we don't use the value returned by the call }
@@ -1029,13 +959,13 @@ implementation
            begin
               if first=nil then
                 begin
-                   last:=cstatementnode.create(nil,statement);
+                   last:=cstatementnode.create(statement,nil);
                    first:=last;
                 end
               else
                 begin
-                   tstatementnode(last).left:=cstatementnode.create(nil,statement);
-                   last:=tstatementnode(last).left;
+                   tstatementnode(last).right:=cstatementnode.create(statement,nil);
+                   last:=tstatementnode(last).right;
                 end;
               if (token in [_END,_FINALIZATION]) then
                 break
@@ -1060,7 +990,7 @@ implementation
 
          dec(statement_level);
 
-         last:=cblocknode.create(first);
+         last:=cblocknode.create(first,true);
          last.set_tree_filepos(filepos);
          statement_block:=last;
       end;
@@ -1081,11 +1011,15 @@ implementation
         parafixup,
         i : longint;
       begin
+        { we don't need to allocate space for the locals }
+        aktprocdef.localst.datasize:=0;
+        procinfo.firsttemp_offset:=0;
         { replace framepointer with stackpointer }
-        procinfo^.framepointer:=STACK_POINTER_REG;
+        procinfo.framepointer.enum:=R_INTREGISTER;
+        procinfo.framepointer.number:=NR_STACK_POINTER_REG;
         { set the right value for parameters }
         dec(aktprocdef.parast.address_fixup,pointer_size);
-        dec(procinfo^.para_offset,pointer_size);
+        dec(procinfo.para_offset,pointer_size);
         { replace all references to parameters in the instructions,
           the parameters can be identified by the parafixup option
           that is set. For normal user coded [ebp+4] this field is not
@@ -1106,7 +1040,8 @@ implementation
                        ref_parafixup :
                          begin
                            ref^.offsetfixup:=parafixup;
-                           ref^.base:=STACK_POINTER_REG;
+                           ref^.base.enum:=R_INTREGISTER;
+                           ref^.base.number:=NR_STACK_POINTER_REG;
                          end;
                      end;
                    end;
@@ -1138,57 +1073,34 @@ implementation
 
       var
         p : tnode;
-        haslocals,hasparas : boolean;
       begin
-         { retrieve info about locals and paras before a result
-           is inserted in the symtable }
-         haslocals:=(aktprocdef.localst.datasize>0);
-         hasparas:=(aktprocdef.parast.datasize>0);
-
-         { temporary space is set, while the BEGIN of the procedure }
-         if symtablestack.symtabletype=localsymtable then
-           procinfo^.firsttemp_offset := -symtablestack.datasize
-         else
-           procinfo^.firsttemp_offset := 0;
-
-         { assembler code does not allocate }
-         { space for the return value       }
+         { Rename the funcret so that recursive calls are possible }
          if not is_void(aktprocdef.rettype.def) then
-           begin
-              aktprocdef.funcretsym:=tfuncretsym.create(aktprocsym.name,aktprocdef.rettype);
-              { insert in local symtable }
-              { but with another name, so that recursive calls are possible }
-              symtablestack.insert(aktprocdef.funcretsym);
-              symtablestack.rename(aktprocdef.funcretsym.name,'$result');
-              { update the symtablesize back to 0 if there were no locals }
-              if not haslocals then
-               symtablestack.datasize:=0;
-              { set the used flag for the return }
-              if ret_in_acc(aktprocdef.rettype.def) then
-                 include(rg.usedinproc,accumulator);
-            end;
+           symtablestack.rename(aktprocdef.funcretsym.name,'$result');
+
          { force the asm statement }
          if token<>_ASM then
            consume(_ASM);
-         procinfo^.Flags := procinfo^.Flags Or pi_is_assembler;
+         procinfo.Flags := procinfo.Flags Or pi_is_assembler;
          p:=_asm_statement;
 
 
          { set the framepointer to esp for assembler functions when the
            following conditions are met:
-           - if the are no local variables
+           - if the are no local variables (except the allocated result)
+           - if the are no parameters
            - no reference to the result variable (refcount<=1)
            - result is not stored as parameter
            - target processor has optional frame pointer save
              (vm, i386, vm only currently)
          }
          if (po_assembler in aktprocdef.procoptions) and
-            (not haslocals) and
-            (not hasparas) and
+            (aktprocdef.parast.datasize=0) and
+            (aktprocdef.localst.datasize=aktprocdef.rettype.def.size) and
             (aktprocdef.owner.symtabletype<>objectsymtable) and
             (not assigned(aktprocdef.funcretsym) or
              (tfuncretsym(aktprocdef.funcretsym).refcount<=1)) and
-            not(ret_in_param(aktprocdef.rettype.def)) and
+            not(paramanager.ret_in_param(aktprocdef.rettype.def,aktprocdef.proccalloption)) and
             (target_cpu in [cpu_i386,cpu_m68k,cpu_vm])
 {$ifdef CHECKFORPUSH}
             and not(UsesPush(tasmnode(p)))
@@ -1196,11 +1108,11 @@ implementation
             then
            OptimizeFramePointer(tasmnode(p));
 
-        { Flag the result as assigned when it is returned in the
-          accumulator or on the fpu stack }
+        { Flag the result as assigned when it is returned in a
+          register.
+        }
         if assigned(aktprocdef.funcretsym) and
-           (is_fpu(aktprocdef.rettype.def) or
-           ret_in_acc(aktprocdef.rettype.def)) then
+           paramanager.ret_in_reg(aktprocdef.rettype.def,aktprocdef.proccalloption) then
           tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
 
         { because the END is already read we need to get the
@@ -1213,219 +1125,158 @@ implementation
 end.
 {
   $Log$
-  Revision 1.54  2002-04-21 19:02:05  peter
-    * removed newn and disposen nodes, the code is now directly
-      inlined from pexpr
-    * -an option that will write the secondpass nodes to the .s file, this
-      requires EXTDEBUG define to actually write the info
-    * fixed various internal errors and crashes due recent code changes
-
-  Revision 1.53  2002/04/20 21:32:24  carl
-  + generic FPC_CHECKPOINTER
-  + first parameter offset in stack now portable
-  * rename some constants
-  + move some cpu stuff to other units
-  - remove unused constents
-  * fix stacksize for some targets
-  * fix generic size problems which depend now on EXTEND_SIZE constant
-
-  Revision 1.52  2002/04/16 16:11:17  peter
-    * using inherited; without a parent having the same function
-      will do nothing like delphi
-
-  Revision 1.51  2002/04/15 19:01:28  carl
-  + target_info.size_of_pointer -> pointer_Size
-
-  Revision 1.50  2002/04/14 16:53:54  carl
-  + asm statement uses ALL_REGISTERS
-
-  Revision 1.49  2002/03/31 20:26:36  jonas
-    + a_loadfpu_* and a_loadmm_* methods in tcg
-    * register allocation is now handled by a class and is mostly processor
-      independent (+rgobj.pas and i386/rgcpu.pas)
-    * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
-    * some small improvements and fixes to the optimizer
-    * some register allocation fixes
-    * some fpuvaroffset fixes in the unary minus node
-    * push/popusedregisters is now called rg.save/restoreusedregisters and
-      (for i386) uses temps instead of push/pop's when using -Op3 (that code is
-      also better optimizable)
-    * fixed and optimized register saving/restoring for new/dispose nodes
-    * LOC_FPU locations now also require their "register" field to be set to
-      R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
-    - list field removed of the tnode class because it's not used currently
-      and can cause hard-to-find bugs
-
-  Revision 1.48  2002/03/11 19:10:28  peter
-    * Regenerated with updated fpcmake
-
-  Revision 1.47  2002/03/04 17:54:59  peter
-    * allow oridinal labels again
-
-  Revision 1.46  2002/01/29 21:32:03  peter
-    * allow accessing locals in other lexlevel when the current assembler
-      routine doesn't have locals.
-
-  Revision 1.45  2002/01/24 18:25:49  peter
-   * implicit result variable generation for assembler routines
-   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
-
-  Revision 1.44  2001/11/09 10:06:56  jonas
-    * allow recursive calls again in assembler procedure
-
-  Revision 1.43  2001/11/02 22:58:05  peter
-    * procsym definition rewrite
-
-  Revision 1.42  2001/10/26 22:36:42  florian
-    * fixed ranges in case statements with widechars
-
-  Revision 1.41  2001/10/25 21:22:37  peter
-    * calling convention rewrite
-
-  Revision 1.40  2001/10/24 11:51:39  marco
-   * Make new/dispose system functions instead of keywords
-
-  Revision 1.39  2001/10/17 22:41:04  florian
-    * several widechar fixes, case works now
-
-  Revision 1.38  2001/10/16 15:10:35  jonas
-    * fixed goto/label/try bugs
-
-  Revision 1.37  2001/09/22 11:11:43  peter
-    * "fpc -P?" command to query for used ppcXXX compiler
-
-  Revision 1.36  2001/09/06 10:21:50  jonas
-    * fixed superfluous generation of stackframes for assembler procedures
-      with no local vars or para's (this broke the backtrace printing in case
-      of an rte)
-
-  Revision 1.35  2001/09/03 13:19:12  jonas
-    * set funcretsym for assembler procedures too (otherwise using __RESULT
-      in assembler procedures causes a crash)
-
-  Revision 1.34  2001/08/26 13:36:46  florian
-    * some cg reorganisation
-    * some PPC updates
-
-  Revision 1.33  2001/08/23 14:28:36  jonas
-    + tempcreate/ref/delete nodes (allows the use of temps in the
-      resulttype and first pass)
-    * made handling of read(ln)/write(ln) processor independent
-    * moved processor independent handling for str and reset/rewrite-typed
-      from firstpass to resulttype pass
-    * changed names of helpers in text.inc to be generic for use as
-      compilerprocs + added "iocheck" directive for most of them
-    * reading of ordinals is done by procedures instead of functions
-      because otherwise FPC_IOCHECK overwrote the result before it could
-      be stored elsewhere (range checking still works)
-    * compilerprocs can now be used in the system unit before they are
-      implemented
-    * added note to errore.msg that booleans can't be read using read/readln
-
-  Revision 1.32  2001/08/06 21:40:47  peter
-    * funcret moved from tprocinfo to tprocdef
-
-  Revision 1.31  2001/06/03 21:57:37  peter
-    + hint directive parsing support
-
-  Revision 1.30  2001/05/17 13:25:24  jonas
-    * fixed web bugs 1480 and 1481
-
-  Revision 1.29  2001/05/04 15:52:04  florian
-    * some Delphi incompatibilities fixed:
-       - out, dispose and new can be used as idenfiers now
-       - const p = apointerype(nil); is supported now
-    + support for const p = apointertype(pointer(1234)); added
-
-  Revision 1.28  2001/04/21 12:03:11  peter
-    * m68k updates merged from fixes branch
-
-  Revision 1.27  2001/04/18 22:01:57  peter
-    * registration of targets and assemblers
-
-  Revision 1.26  2001/04/15 09:48:30  peter
-    * fixed crash in labelnode
-    * easier detection of goto and label in try blocks
-
-  Revision 1.25  2001/04/14 14:07:11  peter
-    * moved more code from pass_1 to det_resulttype
-
-  Revision 1.24  2001/04/13 01:22:13  peter
-    * symtable change to classes
-    * range check generation and errors fixed, make cycle DEBUG=1 works
-    * memory leaks fixed
-
-  Revision 1.23  2001/04/04 22:43:52  peter
-    * remove unnecessary calls to firstpass
-
-  Revision 1.22  2001/04/02 21:20:34  peter
-    * resulttype rewrite
-
-  Revision 1.21  2001/03/22 22:35:42  florian
-    + support for type a = (a=1); in Delphi mode added
-    + procedure p(); in Delphi mode supported
-    + on isn't keyword anymore, it can be used as
-      id etc. now
-
-  Revision 1.20  2001/03/11 22:58:50  peter
-    * getsym redesign, removed the globals srsym,srsymtable
-
-  Revision 1.19  2000/12/25 00:07:27  peter
-    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
-      tlinkedlist objects)
-
-  Revision 1.18  2000/12/23 19:59:35  peter
-    * object to class for ow/og objects
-    * split objectdata from objectoutput
-
-  Revision 1.17  2000/12/16 22:45:55  jonas
-    * fixed case statements with int64 values
-
-  Revision 1.16  2000/11/29 00:30:37  florian
-    * unused units removed from uses clause
-    * some changes for widestrings
-
-  Revision 1.15  2000/11/27 15:47:19  jonas
-    * fix for web bug 1251 (example 1)
-
-  Revision 1.14  2000/11/22 22:43:34  peter
-    * fixed crash with exception without sysutils (merged)
-
-  Revision 1.13  2000/11/04 14:25:21  florian
-    + merged Attila's changes for interfaces, not tested yet
-
-  Revision 1.12  2000/10/31 22:02:50  peter
-    * symtable splitted, no real code changes
-
-  Revision 1.11  2000/10/14 21:52:56  peter
-    * fixed memory leaks
-
-  Revision 1.10  2000/10/14 10:14:52  peter
-    * moehrendorf oct 2000 rewrite
-
-  Revision 1.9  2000/10/01 19:48:25  peter
-    * lot of compile updates for cg11
-
-  Revision 1.8  2000/09/24 21:19:50  peter
-    * delphi compile fixes
-
-  Revision 1.7  2000/09/24 15:06:24  peter
-    * use defines.inc
-
-  Revision 1.6  2000/08/27 16:11:52  peter
-    * moved some util functions from globals,cobjects to cutils
-    * splitted files into finput,fmodule
-
-  Revision 1.5  2000/08/12 15:41:15  peter
-    * fixed bug 1096 (merged)
-
-  Revision 1.4  2000/08/12 06:46:06  florian
-    + case statement for int64/qword implemented
-
-  Revision 1.3  2000/07/13 12:08:27  michael
-  + patched to 1.1.0 with former 1.09patch from peter
-
-  Revision 1.2  2000/07/13 11:32:45  michael
-  + removed logs
+  Revision 1.90  2002-04-25 20:15:40  florian
+    * block nodes within expressions shouldn't release the used registers,
+      fixed using a flag till the new rg is ready
+
+  Revision 1.89  2003/04/25 08:25:26  daniel
+    * Ifdefs around a lot of calls to cleartempgen
+    * Fixed registers that are allocated but not freed in several nodes
+    * Tweak to register allocator to cause less spills
+    * 8-bit registers now interfere with esi,edi and ebp
+      Compiler can now compile rtl successfully when using new register
+      allocator
+
+  Revision 1.88  2003/03/28 19:16:57  peter
+    * generic constructor working for i386
+    * remove fixed self register
+    * esi added as address register for i386
+
+  Revision 1.87  2003/03/17 18:55:30  peter
+    * allow more tokens instead of only semicolon after inherited
+
+  Revision 1.86  2003/02/19 22:00:14  daniel
+    * Code generator converted to new register notation
+    - Horribily outdated todo.txt removed
+
+  Revision 1.85  2003/01/08 18:43:56  daniel
+   * Tregister changed into a record
+
+  Revision 1.84  2003/01/01 21:05:24  peter
+    * fixed assembler methods stackpointer optimization that was
+      broken after the previous change
+
+  Revision 1.83  2002/12/29 18:59:34  peter
+    * fixed parsing of declarations before asm statement
+
+  Revision 1.82  2002/12/27 18:18:56  peter
+    * check for else after empty raise statement
+
+  Revision 1.81  2002/11/27 02:37:14  peter
+    * case statement inlining added
+    * fixed inlining of write()
+    * switched statementnode left and right parts so the statements are
+      processed in the correct order when getcopy is used. This is
+      required for tempnodes
+
+  Revision 1.80  2002/11/25 17:43:22  peter
+    * splitted defbase in defutil,symutil,defcmp
+    * merged isconvertable and is_equal into compare_defs(_ext)
+    * made operator search faster by walking the list only once
+
+  Revision 1.79  2002/11/18 17:31:58  peter
+    * pass proccalloption to ret_in_xxx and push_xxx functions
+
+  Revision 1.78  2002/09/07 19:34:08  florian
+    + tcg.direction is used now
+
+  Revision 1.77  2002/09/07 15:25:07  peter
+    * old logs removed and tabs fixed
+
+  Revision 1.76  2002/09/07 12:16:03  carl
+    * second part bug report 1996 fix, testrange in cordconstnode
+      only called if option is set (also make parsing a tiny faster)
+
+  Revision 1.75  2002/09/02 18:40:52  peter
+    * fixed parsing of register names with lowercase
+
+  Revision 1.74  2002/09/01 14:43:12  peter
+    * fixed direct assembler for i386
+
+  Revision 1.73  2002/08/25 19:25:20  peter
+    * sym.insert_in_data removed
+    * symtable.insertvardata/insertconstdata added
+    * removed insert_in_data call from symtable.insert, it needs to be
+      called separatly. This allows to deref the address calculation
+    * procedures now calculate the parast addresses after the procedure
+      directives are parsed. This fixes the cdecl parast problem
+    * push_addr_param has an extra argument that specifies if cdecl is used
+      or not
+
+  Revision 1.72  2002/08/17 09:23:40  florian
+    * first part of procinfo rewrite
+
+  Revision 1.71  2002/08/16 14:24:58  carl
+    * issameref() to test if two references are the same (then emit no opcodes)
+    + ret_in_reg to replace ret_in_acc
+      (fix some register allocation bugs at the same time)
+    + save_std_register now has an extra parameter which is the
+      usedinproc registers
+
+  Revision 1.70  2002/08/11 14:32:27  peter
+    * renamed current_library to objectlibrary
+
+  Revision 1.69  2002/08/11 13:24:12  peter
+    * saving of asmsymbols in ppu supported
+    * asmsymbollist global is removed and moved into a new class
+      tasmlibrarydata that will hold the info of a .a file which
+      corresponds with a single module. Added librarydata to tmodule
+      to keep the library info stored for the module. In the future the
+      objectfiles will also be stored to the tasmlibrarydata class
+    * all getlabel/newasmsymbol and friends are moved to the new class
+
+  Revision 1.68  2002/08/10 14:46:30  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.67  2002/08/09 19:11:44  carl
+    + reading of used registers in assembler routines is now
+      cpu-independent
+
+  Revision 1.66  2002/08/06 20:55:22  florian
+    * first part of ppc calling conventions fix
+
+  Revision 1.65  2002/07/28 20:45:22  florian
+    + added direct assembler reader for PowerPC
+
+  Revision 1.64  2002/07/20 11:57:56  florian
+    * types.pas renamed to defbase.pas because D6 contains a types
+      unit so this would conflicts if D6 programms are compiled
+    + Willamette/SSE2 instructions to assembler added
+
+  Revision 1.63  2002/07/19 11:41:36  daniel
+  * State tracker work
+  * The whilen and repeatn are now completely unified into whilerepeatn. This
+    allows the state tracker to change while nodes automatically into
+    repeat nodes.
+  * Resulttypepass improvements to the notn. 'not not a' is optimized away and
+    'not(a>b)' is optimized into 'a<=b'.
+  * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
+    by removing the notn and later switchting the true and falselabels. The
+    same is done with 'repeat until not a'.
+
+  Revision 1.62  2002/07/16 15:34:20  florian
+    * exit is now a syssym instead of a keyword
+
+  Revision 1.61  2002/07/11 14:41:28  florian
+    * start of the new generic parameter handling
+
+  Revision 1.60  2002/07/04 20:43:01  florian
+    * first x86-64 patches
+
+  Revision 1.59  2002/07/01 18:46:25  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.58  2002/05/18 13:34:13  peter
+    * readded missing revisions
+
+  Revision 1.57  2002/05/16 19:46:44  carl
+  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+  + try to fix temp allocation (still in ifdef)
+  + generic constructor calls
+  + start of tassembler / tmodulebase class cleanup
 
 }

compiler/x86/cpubase.pas

@@ -146,6 +146,15 @@ uses
       RS_R13        = $0e;      {R13}
       RS_R14        = $0f;      {R14}
       RS_R15        = $10;      {R15}
+      { create aliases to allow code sharing between x86-64 and i386 }
+      RS_EAX        = RS_RAX;
+      RS_EBX        = RS_RBX;
+      RS_ECX        = RS_RCX;
+      RS_EDX        = RS_RDX;
+      RS_ESI        = RS_RSI;
+      RS_EDI        = RS_RDI;
+      RS_EBP        = RS_RBP;
+      RS_ESP        = RS_RSP;
 {$else x86_64}
       RS_SPECIAL    = $00;      {Special register}
       RS_EAX        = $01;      {EAX}
@@ -698,7 +707,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  2002-04-25 16:12:09  florian
+  Revision 1.3  2002-04-25 20:15:40  florian
+    * block nodes within expressions shouldn't release the used registers,
+      fixed using a flag till the new rg is ready
+
+  Revision 1.2  2002/04/25 16:12:09  florian
     * fixed more problems with cpubase and x86-64
 
   Revision 1.1  2003/04/25 11:12:09  florian

compiler/x86_64/rgcpu.pas

@@ -0,0 +1,449 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    This unit implements the i386 specific class for the register
+    allocator
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+unit rgcpu;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      cpubase,
+      cpuinfo,
+      aasmbase,aasmtai,aasmcpu,
+      cclasses,globtype,cgbase,cginfo,rgobj;
+
+    type
+       trgcpu = class(trgobj)
+
+          { to keep the same allocation order as with the old routines }
+          function getregisterint(list:Taasmoutput;size:Tcgsize):Tregister;override;
+{$ifndef newra}
+          procedure ungetregisterint(list:Taasmoutput;r:Tregister); override;
+          function getexplicitregisterint(list:Taasmoutput;r:Tnewregister):Tregister;override;
+{$endif newra}
+
+          function getregisterfpu(list: taasmoutput) : tregister; override;
+          procedure ungetregisterfpu(list: taasmoutput; r : tregister); override;
+
+          procedure ungetreference(list: taasmoutput; const ref : treference); override;
+
+          {# Returns a subset register of the register r with the specified size.
+             WARNING: There is no clearing of the upper parts of the register,
+             if a 8-bit / 16-bit register is converted to a 32-bit register.
+             It is up to the code generator to correctly zero fill the register
+          }
+          function makeregsize(reg: tregister; size: tcgsize): tregister; override;
+
+          procedure resetusableregisters;override;
+
+         { corrects the fpu stack register by ofs }
+         function correct_fpuregister(r : tregister;ofs : byte) : tregister;
+
+         fpuvaroffset : byte;
+       end;
+
+
+  implementation
+
+    uses
+       systems,
+       globals,verbose,
+       tgobj;
+
+{************************************************************************}
+{                         routine helpers                                }
+{************************************************************************}
+
+  const
+    reg2reg64 : array[firstreg..lastreg] of toldregister = (R_NO,
+      R_RAX,R_RCX,R_RDX,R_RBX,R_RSP,R_RBP,R_RSI,R_RDI,
+      R_R8,R_R9,R_R10,R_R11,R_R12,R_R13,R_R14,R_R15,R_RIP,
+      R_RAX,R_RCX,R_RDX,R_RBX,R_RSP,R_RBP,R_RSI,R_RDI,
+      R_R8,R_R9,R_R10,R_R11,R_R12,R_R13,R_R14,R_R15,
+      R_RAX,R_RCX,R_RDX,R_RBX,R_RSP,R_RBP,R_RSI,R_RDI,
+      R_R8,R_R9,R_R10,R_R11,R_R12,R_R13,R_R14,R_R15,
+      R_RAX,R_RCX,R_RDX,R_RBX,R_RSP,R_RBP,R_RSI,R_RDI,
+      R_R8,R_R9,R_R10,R_R11,R_R12,R_R13,R_R14,R_R15,
+      R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO
+    );
+
+    reg2reg32 : array[firstreg..lastreg] of toldregister = (R_NO,
+      R_EAX,R_ECX,R_EDX,R_EBX,R_ESP,R_EBP,R_ESI,R_EDI,
+      R_R8D,R_R9D,R_R10D,R_R11D,R_R12D,R_R13D,R_R14D,R_R15D,R_NO,
+      R_EAX,R_ECX,R_EDX,R_EBX,R_ESP,R_EBP,R_ESI,R_EDI,
+      R_R8D,R_R9D,R_R10D,R_R11D,R_R12D,R_R13D,R_R14D,R_R15D,
+      R_EAX,R_ECX,R_EDX,R_EBX,R_ESP,R_EBP,R_ESI,R_EDI,
+      R_R8D,R_R9D,R_R10D,R_R11D,R_R12D,R_R13D,R_R14D,R_R15D,
+      R_EAX,R_ECX,R_EDX,R_EBX,R_ESP,R_EBP,R_ESI,R_EDI,
+      R_R8D,R_R9D,R_R10D,R_R11D,R_R12D,R_R13D,R_R14D,R_R15D,
+      R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO
+    );
+
+    reg2reg16 : array[firstreg..lastreg] of toldregister = (R_NO,
+      R_AX,R_CX,R_DX,R_BX,R_SP,R_BP,R_SI,R_DI,
+      R_R8W,R_R9W,R_R10W,R_R11W,R_R12W,R_R13W,R_R14W,R_R15W,R_NO,
+      R_AX,R_CX,R_DX,R_BX,R_SP,R_BP,R_SI,R_DI,
+      R_R8W,R_R9W,R_R10W,R_R11W,R_R12W,R_R13W,R_R14W,R_R15W,
+      R_AX,R_CX,R_DX,R_BX,R_SP,R_BP,R_SI,R_DI,
+      R_R8W,R_R9W,R_R10W,R_R11W,R_R12W,R_R13W,R_R14W,R_R15W,
+      R_AX,R_CX,R_DX,R_BX,R_SP,R_BP,R_SI,R_DI,
+      R_R8W,R_R9W,R_R10W,R_R11W,R_R12W,R_R13W,R_R14W,R_R15W,
+      R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO
+    );
+
+    reg2reg8 : array[firstreg..lastreg] of toldregister = (R_NO,
+      R_AL,R_CL,R_DL,R_BL,R_SPL,R_BPL,R_SIL,R_DIL,
+      R_R8B,R_R9B,R_R10B,R_R11B,R_R12B,R_R13B,R_R14B,R_R15B,R_NO,
+      R_AL,R_CL,R_DL,R_BL,R_SPL,R_BPL,R_SIL,R_DIL,
+      R_R8B,R_R9B,R_R10B,R_R11B,R_R12B,R_R13B,R_R14B,R_R15B,
+      R_AL,R_CL,R_DL,R_BL,R_SPL,R_BPL,R_SIL,R_DIL,
+      R_R8B,R_R9B,R_R10B,R_R11B,R_R12B,R_R13B,R_R14B,R_R15B,
+      R_AL,R_CL,R_DL,R_BL,R_SPL,R_BPL,R_SIL,R_DIL,
+      R_R8B,R_R9B,R_R10B,R_R11B,R_R12B,R_R13B,R_R14B,R_R15B,
+      R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,
+      R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO,R_NO
+    );
+
+    { convert a register to a specfied register size }
+    function changeregsize(r:tregister;size:topsize):tregister;
+      var
+        reg : tregister;
+      begin
+        case size of
+          S_B :
+            reg.enum:=reg2reg8[r.enum];
+          S_W :
+            reg.enum:=reg2reg16[r.enum];
+          S_L :
+            reg.enum:=reg2reg32[r.enum];
+          S_Q :
+            reg.enum:=reg2reg64[r.enum];
+          else
+            internalerror(200204101);
+        end;
+        if reg.enum=R_NO then
+         internalerror(200204102);
+        changeregsize:=reg;
+      end;
+
+
+{************************************************************************}
+{                               trgcpu                                   }
+{************************************************************************}
+
+    function trgcpu.getregisterint(list: taasmoutput;size:Tcgsize): tregister;
+    var subreg:Tsubregister;
+
+    begin
+      subreg:=cgsize2subreg(size);
+
+      if countunusedregsint=0 then
+        internalerror(10);
+      result.enum:=R_INTREGISTER;
+{$ifdef TEMPREGDEBUG}
+      if curptree^.usableregsint-countunusedregsint>curptree^.registers32 then
+        internalerror(10);
+{$endif TEMPREGDEBUG}
+{$ifdef EXTTEMPREGDEBUG}
+      if curptree^.usableregs-countunusedregistersint>curptree^^.reallyusedregs then
+        curptree^.reallyusedregs:=curptree^^.usableregs-countunusedregistersint;
+{$endif EXTTEMPREGDEBUG}
+      if RS_RAX in unusedregsint then
+        begin
+          dec(countunusedregsint);
+          exclude(unusedregsint,RS_RAX);
+          include(usedintinproc,RS_RAX);
+          result.number:=RS_RAX shl 8 or subreg;
+{$ifdef TEMPREGDEBUG}
+          reg_user[R_RAX]:=curptree^;
+{$endif TEMPREGDEBUG}
+          exprasmlist.concat(tai_regalloc.alloc(result));
+        end
+      else if RS_RDX in unusedregsint then
+        begin
+          dec(countunusedregsint);
+          exclude(unusedregsint,RS_RDX);
+          include(usedintinproc,RS_RDX);
+          result.number:=RS_RDX shl 8 or subreg;
+{$ifdef TEMPREGDEBUG}
+          reg_user[R_RDX]:=curptree^;
+{$endif TEMPREGDEBUG}
+          exprasmlist.concat(tai_regalloc.alloc(result));
+        end
+      else if RS_RBX in unusedregsint then
+        begin
+          dec(countunusedregsint);
+          exclude(unusedregsint,RS_RBX);
+          include(usedintinproc,RS_RBX);
+          result.number:=RS_RBX shl 8 or subreg;
+{$ifdef TEMPREGDEBUG}
+          reg_user[R_RBX]:=curptree^;
+{$endif TEMPREGDEBUG}
+          exprasmlist.concat(tai_regalloc.alloc(result));
+        end
+      else if RS_RCX in unusedregsint then
+        begin
+          dec(countunusedregsint);
+          exclude(unusedregsint,RS_RCX);
+          include(usedintinproc,RS_RCX);
+          result.number:=RS_RCX shl 8 or subreg;
+{$ifdef TEMPREGDEBUG}
+          reg_user[R_RCX]:=curptree^;
+{$endif TEMPREGDEBUG}
+          exprasmlist.concat(tai_regalloc.alloc(result));
+        end
+      else
+        internalerror(10);
+{$ifdef TEMPREGDEBUG}
+      testregisters;
+{$endif TEMPREGDEBUG}
+    end;
+
+
+
+    procedure trgcpu.ungetregisterint(list: taasmoutput; r : tregister);
+      var supreg:Tsuperregister;
+      begin
+         if r.enum=R_NO then
+          exit;
+         if r.enum<>R_INTREGISTER then
+            internalerror(200301234);
+         supreg:=r.number shr 8;
+         if (supreg in [RS_RDI]) then
+           begin
+             list.concat(tai_regalloc.DeAlloc(r));
+             exit;
+           end;
+         if not(supreg in [RS_RAX,RS_RBX,RS_RCX,RS_RDX,RS_RSI]) then
+           exit;
+         inherited ungetregisterint(list,r);
+      end;
+
+
+   function trgcpu.getexplicitregisterint(list: taasmoutput; r : tnewregister) : tregister;
+
+   var r2:Tregister;
+
+    begin
+      if (r shr 8) in [RS_RDI] then
+        begin
+          r2.enum:=R_INTREGISTER;
+          r2.number:=r;
+          list.concat(Tai_regalloc.alloc(r2));
+          getexplicitregisterint:=r2;
+          exit;
+        end;
+      result:=inherited getexplicitregisterint(list,r);
+    end;
+
+
+    function trgcpu.getregisterfpu(list: taasmoutput) : tregister;
+
+      begin
+        { note: don't return R_ST0, see comments above implementation of }
+        { a_loadfpu_* methods in cgcpu (JM)                              }
+        result.enum := R_ST;
+      end;
+
+
+    procedure trgcpu.ungetregisterfpu(list : taasmoutput; r : tregister);
+
+      begin
+        { nothing to do, fpu stack management is handled by the load/ }
+        { store operations in cgcpu (JM)                              }
+      end;
+
+
+    procedure trgcpu.ungetreference(list: taasmoutput; const ref : treference);
+
+      begin
+         ungetregisterint(list,ref.base);
+         ungetregisterint(list,ref.index);
+      end;
+
+   procedure trgcpu.resetusableregisters;
+
+     begin
+       inherited resetusableregisters;
+       fpuvaroffset := 0;
+     end;
+
+
+   function trgcpu.correct_fpuregister(r : tregister;ofs : byte) : tregister;
+
+     begin
+        correct_fpuregister.enum:=toldregister(longint(r.enum)+ofs);
+     end;
+
+
+    function trgcpu.makeregsize(reg: tregister; size: tcgsize): tregister;
+
+      var
+        _result : topsize;
+      begin
+        case size of
+          OS_32,OS_S32:
+            begin
+              _result := S_L;
+            end;
+          OS_8,OS_S8:
+            begin
+              _result := S_B;
+            end;
+          OS_16,OS_S16:
+            begin
+              _result := S_W;
+            end;
+          else
+            internalerror(2001092312);
+        end;
+        makeregsize := changeregsize(reg,_result);
+      end;
+
+
+
+initialization
+  rg := trgcpu.create(15);
+end.
+
+{
+  $Log$
+  Revision 1.4  2002-04-25 20:15:40  florian
+    * block nodes within expressions shouldn't release the used registers,
+      fixed using a flag till the new rg is ready
+
+  Revision 1.3  2003/01/05 13:36:54  florian
+    * x86-64 compiles
+    + very basic support for float128 type (x86-64 only)
+
+  Revision 1.2  2002/07/25 22:55:34  florian
+    * several fixes, small test units can be compiled
+
+  Revision 1.1  2002/07/24 22:38:15  florian
+    + initial release of x86-64 target code
+
+  Revision 1.8  2002/07/01 18:46:34  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.7  2002/05/16 19:46:52  carl
+  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+  + try to fix temp allocation (still in ifdef)
+  + generic constructor calls
+  + start of tassembler / tmodulebase class cleanup
+
+  Revision 1.6  2002/05/12 16:53:18  peter
+    * moved entry and exitcode to ncgutil and cgobj
+    * foreach gets extra argument for passing local data to the
+      iterator function
+    * -CR checks also class typecasts at runtime by changing them
+      into as
+    * fixed compiler to cycle with the -CR option
+    * fixed stabs with elf writer, finally the global variables can
+      be watched
+    * removed a lot of routines from cga unit and replaced them by
+      calls to cgobj
+    * u32bit-s32bit updates for and,or,xor nodes. When one element is
+      u32bit then the other is typecasted also to u32bit without giving
+      a rangecheck warning/error.
+    * fixed pascal calling method with reversing also the high tree in
+      the parast, detected by tcalcst3 test
+
+  Revision 1.5  2002/04/21 15:43:32  carl
+  * changeregsize -> rg.makeregsize
+  * changeregsize moved from cpubase to here
+
+  Revision 1.4  2002/04/15 19:44:22  peter
+    * fixed stackcheck that would be called recursively when a stack
+      error was found
+    * generic changeregsize(reg,size) for i386 register resizing
+    * removed some more routines from cga unit
+    * fixed returnvalue handling
+    * fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
+
+  Revision 1.3  2002/04/04 19:06:13  peter
+    * removed unused units
+    * use tlocation.size in cg.a_*loc*() routines
+
+  Revision 1.2  2002/04/02 17:11:39  peter
+    * tlocation,treference update
+    * LOC_CONSTANT added for better constant handling
+    * secondadd splitted in multiple routines
+    * location_force_reg added for loading a location to a register
+      of a specified size
+    * secondassignment parses now first the right and then the left node
+      (this is compatible with Kylix). This saves a lot of push/pop especially
+      with string operations
+    * adapted some routines to use the new cg methods
+
+  Revision 1.1  2002/03/31 20:26:40  jonas
+    + a_loadfpu_* and a_loadmm_* methods in tcg
+    * register allocation is now handled by a class and is mostly processor
+      independent (+rgobj.pas and i386/rgcpu.pas)
+    * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
+    * some small improvements and fixes to the optimizer
+    * some register allocation fixes
+    * some fpuvaroffset fixes in the unary minus node
+    * push/popusedregisters is now called rg.save/restoreusedregisters and
+      (for i386) uses temps instead of push/pop's when using -Op3 (that code is
+      also better optimizable)
+    * fixed and optimized register saving/restoring for new/dispose nodes
+    * LOC_FPU locations now also require their "register" field to be set to
+      R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
+    - list field removed of the tnode class because it's not used currently
+      and can cause hard-to-find bugs
+
+}