* result type handling in tcgcal.pass_2 overhauled

  * better tnode.dowrite
  * some ppc stuff fixed

compiler/cg64f32.pas

@@ -42,6 +42,8 @@ unit cg64f32;
          to handle 64-bit integers.
       }
       tcg64f32 = class(tcg64)
+        procedure a_reg_alloc(list : taasmoutput;r : tregister64);override;
+        procedure a_reg_dealloc(list : taasmoutput;r : tregister64);override;
         procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);override;
         procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override;
         procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);override;
@@ -92,6 +94,20 @@ unit cg64f32;
          result.reghi:=reghi;
       end;
 
+    procedure tcg64f32.a_reg_alloc(list : taasmoutput;r : tregister64);
+
+      begin
+         list.concat(tai_regalloc.alloc(r.reglo));
+         list.concat(tai_regalloc.alloc(r.reghi));
+      end;
+
+    procedure tcg64f32.a_reg_dealloc(list : taasmoutput;r : tregister64);
+
+      begin
+         list.concat(tai_regalloc.dealloc(r.reglo));
+         list.concat(tai_regalloc.dealloc(r.reghi));
+      end;
+
     procedure tcg64f32.a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);
       var
         tmpreg: tregister;
@@ -617,7 +633,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.25  2002-08-14 18:41:47  jonas
+  Revision 1.26  2002-08-17 22:09:43  florian
+    * result type handling in tcgcal.pass_2 overhauled
+    * better tnode.dowrite
+    * some ppc stuff fixed
+
+  Revision 1.25  2002/08/14 18:41:47  jonas
     - remove valuelow/valuehigh fields from tlocation, because they depend
       on the endianess of the host operating system -> difficult to get
       right. Use lo/hi(location.valueqword) instead (remember to use

compiler/cg64f64.pas

@@ -174,10 +174,28 @@ unit cg64f64;
       begin
       end;
 
+    procedure tcg.a_reg_alloc(list : taasmoutput;r : tregister64);
+
+      begin
+         list.concat(tai_regalloc.alloc(r));
+      end;
+
+    procedure tcg.a_reg_dealloc(list : taasmoutput;r : tregister64);
+
+      begin
+         list.concat(tai_regalloc.dealloc(r));
+      end;
+
+
 end.
 {
   $Log$
-  Revision 1.2  2002-07-01 16:23:52  peter
+  Revision 1.3  2002-08-17 22:09:43  florian
+    * result type handling in tcgcal.pass_2 overhauled
+    * better tnode.dowrite
+    * some ppc stuff fixed
+
+  Revision 1.2  2002/07/01 16:23:52  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)
@@ -185,4 +203,4 @@ end.
   Revision 1.1  2002/06/08 19:36:54  florian
     * initial release
 
-}
+}

compiler/cgobj.pas

@@ -410,6 +410,10 @@ unit cgobj;
        for 64 Bit operations.
     }
     tcg64 = class
+        { Allocates 64 Bit register r by inserting a pai_realloc record }
+        procedure a_reg_alloc(list : taasmoutput;r : tregister64);virtual;abstract;
+        { Deallocates 64 Bit register r by inserting a pa_regdealloc record}
+        procedure a_reg_dealloc(list : taasmoutput;r : tregister64);virtual;abstract;
         procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);virtual;abstract;
         procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);virtual;abstract;
         procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);virtual;abstract;
@@ -814,7 +818,8 @@ unit cgobj;
           LOC_FPUREGISTER, LOC_CFPUREGISTER:
             a_loadfpu_reg_reg(list,loc.register,reg);
           else
-            internalerror(200203301);
+            runerror(226);
+            // internalerror(200203301);
         end;
       end;
 
@@ -1548,7 +1553,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.51  2002-08-17 09:23:33  florian
+  Revision 1.52  2002-08-17 22:09:43  florian
+    * result type handling in tcgcal.pass_2 overhauled
+    * better tnode.dowrite
+    * some ppc stuff fixed
+
+  Revision 1.51  2002/08/17 09:23:33  florian
     * first part of procinfo rewrite
 
   Revision 1.50  2002/08/16 14:24:57  carl

compiler/nbas.pas

@@ -60,7 +60,7 @@ 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;
@@ -295,7 +295,7 @@ implementation
       end;
 
 {$ifdef extdebug}
-    procedure tstatementnode.dowrite;
+    procedure tstatementnode._dowrite;
 
       begin
          { can't use inherited dowrite, because that will use the
@@ -694,7 +694,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.32  2002-08-17 09:23:34  florian
+  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

compiler/ncal.pas

@@ -1706,7 +1706,9 @@ implementation
                end;
            end;
          { a fpu can be used in any procedure !! }
+{$ifdef i386}
          registersfpu:=procdefinition.fpu_used;
+{$endif i386}
          { if this is a call to a method calc the registers }
          if (methodpointer<>nil) then
            begin
@@ -1904,7 +1906,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.85  2002-08-17 09:23:34  florian
+  Revision 1.86  2002-08-17 22:09:44  florian
+    * result type handling in tcgcal.pass_2 overhauled
+    * better tnode.dowrite
+    * some ppc stuff fixed
+
+  Revision 1.85  2002/08/17 09:23:34  florian
     * first part of procinfo rewrite
 
   Revision 1.84  2002/08/16 14:24:57  carl

compiler/ncgcal.pas

@@ -1,5 +1,5 @@
 {
-    $Id$
+    Id: ncgcal.pas,v 1.10 2002/08/17 09:23:35 florian Exp $
     Copyright (c) 1998-2002 by Florian Klaempfl
 
     Generate i386 assembler for in call nodes
@@ -280,6 +280,7 @@ implementation
          funcretref,refcountedtemp : treference;
          tmpreg : tregister;
          hregister : tregister;
+         hregister64 : tregister64;
          oldpushedparasize : longint;
          { true if ESI must be loaded again after the subroutine }
          loadesi : boolean;
@@ -317,6 +318,7 @@ implementation
          pop_allowed : boolean;
          release_tmpreg : boolean;
          constructorfailed : tasmlabel;
+         resultloc : tparalocation;
 
       label
          dont_call;
@@ -551,7 +553,7 @@ implementation
                end
              else
                cg.a_paramaddr_ref(exprasmlist,funcretref,
-                 paramanager.getfuncretloc(procdefinition));
+                 paramanager.getfuncretparaloc(procdefinition));
            end;
 
          { procedure variable or normal function call ? }
@@ -1142,13 +1144,10 @@ implementation
               end
             else
             { we have only to handle the result if it is used }
-             if (nf_return_value_used in flags) then
+             if (nf_return_value_used in flags) and paramanager.ret_in_reg(resulttype.def) then
               begin
-                case resulttype.def.deftype of
-                  enumdef,
-                  orddef :
-                    begin
-                      cgsize:=def_cgsize(resulttype.def);
+                 resultloc:=paramanager.getfuncresultloc(resulttype.def);
+{$ifdef dummy}
                       { an object constructor is a function with boolean result }
                       if (inlined or (right=nil)) and
                          (procdefinition.proctypeoption=potype_constructor) then
@@ -1157,61 +1156,51 @@ implementation
                           cgsize:=OS_INT
                          else
                           begin
-{$ifdef dummy}
                             cgsize:=OS_NO;
                             { this fails if popsize > 0 PM }
                             location_reset(location,LOC_FLAGS,OS_NO);
                             location.resflags:=F_NE;
-{$endif dummy}
                           end;
                        end;
-
-                      if cgsize<>OS_NO then
-                       begin
+{$endif dummy}
+                 cgsize:=resultloc.size;
+                 case resultloc.loc of
+                    LOC_REGISTER:
+                      begin
                          location_reset(location,LOC_REGISTER,cgsize);
-                         cg.a_reg_alloc(exprasmlist,accumulator);
                          if cgsize in [OS_64,OS_S64] then
-                          begin
-                            cg.a_reg_alloc(exprasmlist,accumulatorhigh);
-                            if accumulatorhigh in rg.unusedregsint then
-                              begin
-                                 location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh);
-                                 location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator);
-                              end
-                            else
-                              begin
-                                 location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh);
-                                 location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator);
-                              end;
-                            cg64.a_load64_reg_reg(exprasmlist,joinreg64(accumulator,accumulatorhigh),
-                                location.register64);
-                          end
+                           begin
+                              cg64.a_reg_alloc(exprasmlist,resultloc.register64);
+                              {  FIX ME !!!
+                              location.register:=rg.getexplicitregisterint(exprasmlist,resultloc.register64);
+                              }
+                              location.register64.reglo:=rg.getexplicitregisterint(exprasmlist,resultloc.register64.reglo);
+                              location.register64.reghi:=rg.getexplicitregisterint(exprasmlist,resultloc.register64.reghi);
+                              cg64.a_load64_reg_reg(exprasmlist,resultloc.register64,location.register64);
+                           end
                          else
-                          begin
-                            location.register:=rg.getexplicitregisterint(exprasmlist,accumulator);
-                            hregister:=rg.makeregsize(accumulator,cgsize);
-                            location.register:=rg.makeregsize(location.register,cgsize);
-                            cg.a_load_reg_reg(exprasmlist,cgsize,hregister,location.register);
-                          end;
-                       end;
-                    end;
-                  floatdef :
-                    begin
-{$ifdef dummy}
-                      location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
-                      location.register:=R_ST;
-                      inc(trgcpu(rg).fpuvaroffset);
-{$endif dummy}
-
-                    end;
-                  else
-                    begin
-                      location_reset(location,LOC_REGISTER,OS_INT);
-                      location.register:=rg.getexplicitregisterint(exprasmlist,accumulator);
-                      cg.a_load_reg_reg(exprasmlist,OS_INT,accumulator,location.register);
-                    end;
-                end;
-             end;
+                           begin
+                              cg.a_reg_alloc(exprasmlist,resultloc.register);
+                              location.register:=rg.getexplicitregisterint(exprasmlist,resultloc.register);
+                              hregister:=rg.makeregsize(resultloc.register,cgsize);
+                              location.register:=rg.makeregsize(location.register,cgsize);
+                              cg.a_load_reg_reg(exprasmlist,cgsize,hregister,location.register);
+                           end;
+                      end;
+                    LOC_FPUREGISTER:
+                      begin
+                         location_reset(location,LOC_FPUREGISTER,cgsize);
+                         cg.a_reg_alloc(exprasmlist,resultloc.register);
+                         location.register:=rg.getexplicitregisterfpu(exprasmlist,resultloc.register);
+                         cg.a_loadfpu_reg_reg(exprasmlist,resultloc.register,location.register);
+{$ifdef x86}
+                         inc(trgcpu(rg).fpuvaroffset);
+{$endif x86}
+                      end;
+                    else
+                      internalerror(2002081701);
+                 end;
+              end;
           end;
 
          { perhaps i/o check ? }
@@ -1475,7 +1464,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2002-08-17 09:23:35  florian
+  Revision 1.11  2002-08-17 22:09:44  florian
+    * result type handling in tcgcal.pass_2 overhauled
+    * better tnode.dowrite
+    * some ppc stuff fixed
+
+  Revision 1.10  2002/08/17 09:23:35  florian
     * first part of procinfo rewrite
 
   Revision 1.9  2002/08/13 21:40:55  florian

compiler/ncon.pas

@@ -54,7 +54,7 @@ interface
           function det_resulttype:tnode;override;
           function docompare(p: tnode) : boolean; override;
        {$ifdef extdebug}
-          procedure dowrite;override;
+          procedure _dowrite;override;
        {$endif}
        end;
        tordconstnodeclass = class of tordconstnode;
@@ -268,7 +268,7 @@ implementation
     function is_emptyset(p : tnode):boolean;
 
     begin
-        is_emptyset:=(p.nodetype=setconstn) and 
+        is_emptyset:=(p.nodetype=setconstn) and
 	 (Tsetconstnode(p).value_set^=[]);
     end;
 {$endif}
@@ -410,11 +410,11 @@ implementation
       end;
 
 {$ifdef extdebug}
-    procedure Tordconstnode.dowrite;
+    procedure Tordconstnode._dowrite;
 
     begin
-	inherited dowrite;
-	write('[',value,']');
+	inherited _dowrite;
+        system.write(writenodeindention,',value = ',value);
     end;
 {$endif}
 
@@ -750,7 +750,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.37  2002-07-23 12:34:30  daniel
+  Revision 1.38  2002-08-17 22:09:45  florian
+    * result type handling in tcgcal.pass_2 overhauled
+    * better tnode.dowrite
+    * some ppc stuff fixed
+
+  Revision 1.37  2002/07/23 12:34:30  daniel
   * Readded old set code. To use it define 'oldset'. Activated by default
     for ppc.
 

compiler/nflw.pas

@@ -39,7 +39,7 @@ interface
           function getcopy : tnode;override;
           procedure insertintolist(l : tnodelist);override;
 {$ifdef extdebug}
-          procedure dowrite;override;
+          procedure _dowrite;override;
 {$endif extdebug}
           function docompare(p: tnode): boolean; override;
        end;
@@ -256,9 +256,9 @@ implementation
       begin
       end;
 {$ifdef extdebug}
-    procedure tloopnode.dowrite;
+    procedure tloopnode._dowrite;
       begin
-        inherited dowrite;
+        inherited _dowrite;
         writenodeindention:=writenodeindention+'    ';
         writenode(t1);
         writenode(t2);
@@ -1244,7 +1244,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.45  2002-08-17 09:23:37  florian
+  Revision 1.46  2002-08-17 22:09:46  florian
+    * result type handling in tcgcal.pass_2 overhauled
+    * better tnode.dowrite
+    * some ppc stuff fixed
+
+  Revision 1.45  2002/08/17 09:23:37  florian
     * first part of procinfo rewrite
 
   Revision 1.44  2002/07/21 06:58:49  daniel

compiler/nld.pas

@@ -46,7 +46,7 @@ interface
           function  det_resulttype:tnode;override;
           function  docompare(p: tnode): boolean; override;
        {$ifdef extdebug}
-          procedure dowrite;override;
+          procedure _dowrite;override;
        {$endif}
        end;
        tloadnodeclass = class of tloadnode;
@@ -405,11 +405,12 @@ implementation
       end;
 
 {$ifdef extdebug}
-    procedure Tloadnode.dowrite;
+    procedure Tloadnode._dowrite;
 
     begin
-	inherited dowrite;
-	write('[',symtableentry.name,']');
+        inherited _dowrite;
+        writeln(',');
+        system.write(writenodeindention,'symbol = ',symtableentry.name);
     end;
 {$endif}
 
@@ -995,7 +996,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.50  2002-08-17 09:23:37  florian
+  Revision 1.51  2002-08-17 22:09:46  florian
+    * result type handling in tcgcal.pass_2 overhauled
+    * better tnode.dowrite
+    * some ppc stuff fixed
+
+  Revision 1.50  2002/08/17 09:23:37  florian
     * first part of procinfo rewrite
 
   Revision 1.49  2002/07/20 11:57:54  florian

compiler/node.pas

@@ -351,8 +351,9 @@ interface
           { writes a node for debugging purpose, shouldn't be called }
           { direct, because there is no test for nil, use writenode  }
           { to write a complete tree                                 }
-          procedure dowrite;virtual;
+          procedure dowrite;
           procedure dowritenodetype;virtual;
+          procedure _dowrite;virtual;
 {$endif EXTDEBUG}
           procedure concattolist(l : tlinkedlist);virtual;
           function ischild(p : tnode) : boolean;virtual;
@@ -381,7 +382,7 @@ interface
           procedure insertintolist(l : tnodelist);override;
           procedure left_max;
 {$ifdef extdebug}
-          procedure dowrite;override;
+          procedure _dowrite;override;
 {$endif extdebug}
        end;
 
@@ -400,7 +401,7 @@ interface
           procedure insertintolist(l : tnodelist);override;
           procedure left_right_max;
 {$ifdef extdebug}
-          procedure dowrite;override;
+          procedure _dowrite;override;
 {$endif extdebug}
        end;
 
@@ -466,7 +467,7 @@ implementation
          else
           write(writenodeindention,'nil');
          if writenodeindention='' then
-          writeln;
+           writeln;
        end;
 {$endif EXTDEBUG}
 
@@ -572,14 +573,27 @@ implementation
       end;
 
 {$ifdef EXTDEBUG}
-    procedure tnode.dowrite;
+    procedure tnode._dowrite;
       begin
         dowritenodetype;
+        system.write(',resulttype = "',resulttype.def.gettypename,'"');
+        system.write(',location.loc = ',ord(location.loc));
+        system.write(',registersfpu = ',registersfpu);
       end;
 
     procedure tnode.dowritenodetype;
       begin
-         write(writenodeindention,'(',nodetype2str[nodetype]);
+          system.write(nodetype2str[nodetype]);
+      end;
+
+    procedure tnode.dowrite;
+      begin
+         system.write(writenodeindention,'(');
+         writenodeindention:=writenodeindention+'    ';
+         _dowrite;
+         writeln(writenodeindention);
+         delete(writenodeindention,1,4);
+         system.write(writenodeindention,')');
       end;
 {$endif EXTDEBUG}
 
@@ -721,15 +735,12 @@ implementation
       end;
 
 {$ifdef extdebug}
-    procedure tunarynode.dowrite;
+    procedure tunarynode._dowrite;
 
       begin
-         inherited dowrite;
+         inherited _dowrite;
          writeln(',');
-         writenodeindention:=writenodeindention+'    ';
          writenode(left);
-         write(')');
-         delete(writenodeindention,1,4);
       end;
 {$endif}
 
@@ -874,15 +885,12 @@ implementation
       end;
 
 {$ifdef extdebug}
-    procedure tbinarynode.dowrite;
+    procedure tbinarynode._dowrite;
 
       begin
-         inherited dowrite;
+         inherited _dowrite;
          writeln(',');
-         writenodeindention:=writenodeindention+'    ';
          writenode(right);
-         write(')');
-         delete(writenodeindention,1,4);
       end;
 {$endif}
 
@@ -906,11 +914,15 @@ implementation
             right.isequal(tbinopnode(p).left));
       end;
 
-
 end.
 {
   $Log$
-  Revision 1.35  2002-08-15 19:10:35  peter
+  Revision 1.36  2002-08-17 22:09:46  florian
+    * result type handling in tcgcal.pass_2 overhauled
+    * better tnode.dowrite
+    * some ppc stuff fixed
+
+  Revision 1.35  2002/08/15 19:10:35  peter
     * first things tai,tnode storing in ppu
 
   Revision 1.34  2002/08/09 19:15:41  carl

compiler/paramgr.pas

@@ -2,7 +2,7 @@
     $Id$
     Copyright (c) 2002 by Florian Klaempfl
 
-    PowerPC specific calling conventions
+    Generic calling convention handling
 
     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
@@ -70,7 +70,7 @@ unit paramgr;
             Returns the location where the invisible parameter for structured
             function results will be passed.
           }
-          function getfuncretloc(p : tabstractprocdef) : tparalocation;virtual;abstract;
+          function getfuncretparaloc(p : tabstractprocdef) : tparalocation;virtual;abstract;
           { Returns the self pointer location for the given tabstractprocdef,
             when the stack frame is already created. This is used by the code
             generating the wrappers for implemented interfaces.
@@ -84,7 +84,7 @@ unit paramgr;
 
             @param(def The definition of the result type of the function)
           }
-          function getfuncresultlocreg(def : tdef): tparalocation; virtual;
+          function getfuncresultloc(def : tdef): tparalocation; virtual;
        end;
 
     procedure setparalocs(p : tprocdef);
@@ -169,21 +169,21 @@ unit paramgr;
       end;
 
 
-    function tparamanager.getfuncresultlocreg(def : tdef): tparalocation;
+    function tparamanager.getfuncresultloc(def : tdef): tparalocation;
       begin
          fillchar(result,sizeof(tparalocation),0);
          if is_void(def) then exit;
 
          result.size := def_cgsize(def);
-         case aktprocdef.rettype.def.deftype of
+         case def.deftype of
            orddef,
            enumdef :
              begin
                result.loc := LOC_REGISTER;
                if result.size in [OS_64,OS_S64] then
                 begin
-                  result.registerhigh:=accumulatorhigh;
-                  result.register:=accumulator;
+                  result.register64.reghi:=accumulatorhigh;
+                  result.register64.reglo:=accumulator;
                 end
                else
                   result.register:=accumulator;
@@ -198,7 +198,7 @@ unit paramgr;
              end;
           else
              begin
-                if ret_in_acc(def) then
+                if ret_in_reg(def) then
                   begin
                     result.loc := LOC_REGISTER;
                     result.register := accumulator;
@@ -238,7 +238,7 @@ unit paramgr;
         }
         if not paramanager.ret_in_reg(def) then
           exit;
-        paramloc := paramanager.getfuncresultlocreg(def);
+        paramloc := paramanager.getfuncresultloc(def);
         case paramloc.loc of
           LOC_FPUREGISTER,
           LOC_CFPUREGISTER,
@@ -302,7 +302,12 @@ end.
 
 {
    $Log$
-   Revision 1.13  2002-08-17 09:23:38  florian
+   Revision 1.14  2002-08-17 22:09:47  florian
+     * result type handling in tcgcal.pass_2 overhauled
+     * better tnode.dowrite
+     * some ppc stuff fixed
+
+   Revision 1.13  2002/08/17 09:23:38  florian
      * first part of procinfo rewrite
 
    Revision 1.12  2002/08/16 14:24:58  carl

compiler/powerpc/cpupara.pas

@@ -35,7 +35,7 @@ unit cpupara;
        tppcparamanager = class(tparamanager)
           function getintparaloc(nr : longint) : tparalocation;override;
           procedure create_param_loc_info(p : tabstractprocdef);override;
-          function getfuncretloc(p : tabstractprocdef) : tparalocation;override;
+          function getfuncretparaloc(p : tabstractprocdef) : tparalocation;override;
        end;
 
   implementation
@@ -214,11 +214,11 @@ unit cpupara;
            end;
       end;
 
-    function tppcparamanager.getfuncretloc(p : tabstractprocdef) : tparalocation;
+    function tppcparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
 
       begin
-         getfuncretloc.loc:=LOC_REGISTER;
-         getfuncretloc.register:=R_3;
+         getfuncretparaloc.loc:=LOC_REGISTER;
+         getfuncretparaloc.register:=R_3;
       end;
 
 begin
@@ -226,7 +226,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2002-08-13 21:40:58  florian
+  Revision 1.7  2002-08-17 22:09:47  florian
+    * result type handling in tcgcal.pass_2 overhauled
+    * better tnode.dowrite
+    * some ppc stuff fixed
+
+  Revision 1.6  2002/08/13 21:40:58  florian
     * more fixes for ppc calling conventions
 
   Revision 1.5  2002/07/30 20:50:44  florian

compiler/powerpc/nppcadd.pas

@@ -75,6 +75,7 @@ interface
         { in case of constant put it to the left }
         if (left.nodetype=ordconstn) then
          swapleftright;
+
         secondpass(left);
 
         { are too few registers free? }
@@ -198,7 +199,7 @@ interface
         if (right.location.loc = LOC_CONSTANT) then
           begin
 {$ifdef extdebug}
-            if (high(right.location.valueqword) <> 0) then
+            if (right.location.size in [OS_64,OS_S64]) and (hi(right.location.valueqword)<>0) and ((hi(right.location.valueqword)<>-1) or unsigned) then
               internalerror(2002080301);
 {$endif extdebug}
             if (nodetype in [equaln,unequaln]) then
@@ -496,8 +497,8 @@ interface
           end
         else
           begin
-            exprasmlist.concat(taicpu.op_reg_reg(op,
-              left.location.register,right.location.register))
+            exprasmlist.concat(taicpu.op_reg_reg_reg(op,
+              location.resflags.cr,left.location.register,right.location.register))
           end;
 
         clear_left_right(cmpop);
@@ -1302,7 +1303,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2002-08-14 18:41:48  jonas
+  Revision 1.13  2002-08-17 22:09:47  florian
+    * result type handling in tcgcal.pass_2 overhauled
+    * better tnode.dowrite
+    * some ppc stuff fixed
+
+  Revision 1.12  2002/08/14 18:41:48  jonas
     - remove valuelow/valuehigh fields from tlocation, because they depend
       on the endianess of the host operating system -> difficult to get
       right. Use lo/hi(location.valueqword) instead (remember to use

compiler/rgobj.pas

@@ -152,6 +152,11 @@ unit rgobj;
              @param(r specific register to allocate)
           }
           function getexplicitregisterint(list: taasmoutput; r : tregister) : tregister;virtual;
+          {# Tries to allocate the passed fpu register, if possible
+
+             @param(r specific register to allocate)
+          }
+          function getexplicitregisterfpu(list : taasmoutput; r : tregister) : tregister;
 
           {# Deallocate any kind of register }
           procedure ungetregister(list: taasmoutput; r : tregister); virtual;
@@ -423,12 +428,37 @@ unit rgobj;
       end;
 
 
+    { tries to allocate the passed register, if possible }
+    function trgobj.getexplicitregisterfpu(list : taasmoutput; r : tregister) : tregister;
+
+      begin
+         if r in unusedregsfpu then
+           begin
+              dec(countunusedregsfpu);
+{$ifdef TEMPREGDEBUG}
+              if curptree^^.usableregs-countunusedregsint>curptree^^.registers32 then
+                internalerror(10);
+              reg_user[r]:=curptree^;
+{$endif TEMPREGDEBUG}
+              exclude(unusedregsint,r);
+              include(usedinproc,r);
+              include(usedbyproc,r);
+              list.concat(tai_regalloc.alloc(r));
+              getexplicitregisterfpu:=r;
+{$ifdef TEMPREGDEBUG}
+              testregisters32;
+{$endif TEMPREGDEBUG}
+           end
+         else
+           getexplicitregisterfpu:=getregisterfpu(list);
+      end;
+
     function trgobj.getregisterfpu(list: taasmoutput) : tregister;
       begin
         if countunusedregsfpu=0 then
-           internalerror(10);
-       result := getregistergen(list,firstsavefpureg,lastsavefpureg,
-                   unusedregsfpu,countunusedregsfpu);
+          internalerror(10);
+        result := getregistergen(list,firstsavefpureg,lastsavefpureg,
+          unusedregsfpu,countunusedregsfpu);
       end;
 
 
@@ -963,7 +993,12 @@ end.
 
 {
   $Log$
-  Revision 1.17  2002-08-17 09:23:42  florian
+  Revision 1.18  2002-08-17 22:09:47  florian
+    * result type handling in tcgcal.pass_2 overhauled
+    * better tnode.dowrite
+    * some ppc stuff fixed
+
+  Revision 1.17  2002/08/17 09:23:42  florian
     * first part of procinfo rewrite
 
   Revision 1.16  2002/08/06 20:55:23  florian