* fixed internalerror(10) due to previous fpu overflow fixes ("merged")

  * fixed bug in n386add (introduced after compilerproc changes for string
    operations) where calcregisters wasn't called for shortstring addnodes
  * NOTE: from now on, the location of a binary node must now always be set
     before you call calcregisters() for it

compiler/htypechk.pas

@@ -416,8 +416,17 @@ implementation
          begin
            if assigned(p.right) then
             begin
-              if (abs(p.left.registers32-p.right.registers32)<r32) then
-               inc(p.registers32,r32);
+              { the location must be already filled in because we need it to }
+              { calculate the necessary number of registers (JM)             }
+              if p.location.loc = LOC_INVALID then
+                internalerror(200110101);
+
+              if (abs(p.left.registers32-p.right.registers32)<r32) or
+                 ((p.location.loc = LOC_FPU) and
+                  (p.right.registersfpu <= p.left.registersfpu) and
+                  ((p.right.registersfpu <> 0) or (p.left.registersfpu <> 0)) and
+                  (p.left.registers32   < p.right.registers32)) then
+                inc(p.registers32,r32);
               if (abs(p.left.registersfpu-p.right.registersfpu)<fpu) then
                inc(p.registersfpu,fpu);
 {$ifdef SUPPORT_MMX}
@@ -958,7 +967,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.35  2001-09-17 21:29:11  peter
+  Revision 1.36  2001-10-12 13:51:51  jonas
+    * fixed internalerror(10) due to previous fpu overflow fixes ("merged")
+    * fixed bug in n386add (introduced after compilerproc changes for string
+      operations) where calcregisters wasn't called for shortstring addnodes
+    * NOTE: from now on, the location of a binary node must now always be set
+       before you call calcregisters() for it
+
+  Revision 1.35  2001/09/17 21:29:11  peter
     * merged netbsd, fpu-overflow from fixes branch
 
   Revision 1.34  2001/09/07 07:46:17  jonas

compiler/i386/n386add.pas

@@ -45,8 +45,8 @@ interface
     uses
       globtype,systems,
       cutils,verbose,globals,widestr,
-      symconst,symdef,aasm,types,
-      cgbase,temp_gen,pass_2,
+      symconst,symdef,aasm,types,htypechk,
+      cgbase,temp_gen,pass_2,regvars,
       cpuasm,
       ncon,nset,
       cga,n386util,tgcpu;
@@ -54,48 +54,45 @@ interface
     function ti386addnode.getresflags(unsigned : boolean) : tresflags;
 
       begin
-         if not(unsigned) then
-           begin
-              if nf_swaped in flags then
-                case nodetype of
-                   equaln : getresflags:=F_E;
-                   unequaln : getresflags:=F_NE;
-                   ltn : getresflags:=F_G;
-                   lten : getresflags:=F_GE;
-                   gtn : getresflags:=F_L;
-                   gten : getresflags:=F_LE;
-                end
-              else
-                case nodetype of
-                   equaln : getresflags:=F_E;
-                   unequaln : getresflags:=F_NE;
-                   ltn : getresflags:=F_L;
-                   lten : getresflags:=F_LE;
-                   gtn : getresflags:=F_G;
-                   gten : getresflags:=F_GE;
-                end;
-           end
-         else
-           begin
-              if nf_swaped in flags then
-                case nodetype of
-                   equaln : getresflags:=F_E;
-                   unequaln : getresflags:=F_NE;
-                   ltn : getresflags:=F_A;
-                   lten : getresflags:=F_AE;
-                   gtn : getresflags:=F_B;
-                   gten : getresflags:=F_BE;
-                end
-              else
-                case nodetype of
-                   equaln : getresflags:=F_E;
-                   unequaln : getresflags:=F_NE;
-                   ltn : getresflags:=F_B;
-                   lten : getresflags:=F_BE;
-                   gtn : getresflags:=F_A;
-                   gten : getresflags:=F_AE;
-                end;
-           end;
+         case nodetype of
+           equaln : getresflags:=F_E;
+           unequaln : getresflags:=F_NE;
+          else
+           if not(unsigned) then
+             begin
+                if nf_swaped in flags then
+                  case nodetype of
+                     ltn : getresflags:=F_G;
+                     lten : getresflags:=F_GE;
+                     gtn : getresflags:=F_L;
+                     gten : getresflags:=F_LE;
+                  end
+                else
+                  case nodetype of
+                     ltn : getresflags:=F_L;
+                     lten : getresflags:=F_LE;
+                     gtn : getresflags:=F_G;
+                     gten : getresflags:=F_GE;
+                  end;
+             end
+           else
+             begin
+                if nf_swaped in flags then
+                  case nodetype of
+                     ltn : getresflags:=F_A;
+                     lten : getresflags:=F_AE;
+                     gtn : getresflags:=F_B;
+                     gten : getresflags:=F_BE;
+                  end
+                else
+                  case nodetype of
+                     ltn : getresflags:=F_B;
+                     lten : getresflags:=F_BE;
+                     gtn : getresflags:=F_A;
+                     gten : getresflags:=F_AE;
+                  end;
+             end;
+         end;
       end;
 
 
@@ -142,6 +139,11 @@ interface
                 ((right.nodetype=stringconstn) and (str_length(right)=0))) and
             is_shortstring(left.resulttype.def)) then
           begin
+            if nodetype = addn then
+              location.loc := LOC_MEM
+            else
+              location.loc := LOC_FLAGS;
+            calcregisters(self,0,0,0);
             result := nil;
             exit;
           end;
@@ -299,6 +301,7 @@ interface
            oldnodetype : tnodetype;
 
         begin
+           load_all_regvars(exprasmlist);
            { the jump the sequence is a little bit hairy }
            case nodetype of
               ltn,gtn:
@@ -1861,7 +1864,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.24  2001-09-17 21:29:13  peter
+  Revision 1.25  2001-10-12 13:51:51  jonas
+    * fixed internalerror(10) due to previous fpu overflow fixes ("merged")
+    * fixed bug in n386add (introduced after compilerproc changes for string
+      operations) where calcregisters wasn't called for shortstring addnodes
+    * NOTE: from now on, the location of a binary node must now always be set
+       before you call calcregisters() for it
+
+  Revision 1.24  2001/09/17 21:29:13  peter
     * merged netbsd, fpu-overflow from fixes branch
 
   Revision 1.23  2001/09/05 15:22:09  jonas

compiler/i386/n386util.pas

@@ -1237,15 +1237,17 @@ implementation
                internalerror(234234);
            end
          else
-           if ((p.location.loc=LOC_FPU) and
-               (p.right.registersfpu > p.left.registersfpu)) or
-              ((p.location.loc<>LOC_FPU) and
-               (p.left.registers32<p.right.registers32) and
+           if (((p.location.loc=LOC_FPU) and
+                (p.right.registersfpu > p.left.registersfpu)) or
+               ((((p.left.registersfpu = 0) and
+                  (p.right.registersfpu = 0)) or
+                 (p.location.loc<>LOC_FPU)) and
+                (p.left.registers32<p.right.registers32))) and
            { the following check is appropriate, because all }
            { 4 registers are rarely used and it is thereby   }
            { achieved that the extra code is being dropped   }
            { by exchanging not commutative operators     }
-               (p.right.registers32<=4)) then
+               (p.right.registers32<=4) then
             begin
               hp:=p.left;
               p.left:=p.right;
@@ -1532,7 +1534,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.21  2001-09-17 21:29:14  peter
+  Revision 1.22  2001-10-12 13:51:52  jonas
+    * fixed internalerror(10) due to previous fpu overflow fixes ("merged")
+    * fixed bug in n386add (introduced after compilerproc changes for string
+      operations) where calcregisters wasn't called for shortstring addnodes
+    * NOTE: from now on, the location of a binary node must now always be set
+       before you call calcregisters() for it
+
+  Revision 1.21  2001/09/17 21:29:14  peter
     * merged netbsd, fpu-overflow from fixes branch
 
   Revision 1.20  2001/08/26 13:37:01  florian

compiler/nadd.pas

@@ -1337,6 +1337,7 @@ implementation
          { int/int gives real/real! }
          if nodetype=slashn then
            begin
+             location.loc:=LOC_FPU;
              { maybe we need an integer register to save }
              { a reference                               }
              if ((left.location.loc<>LOC_FPU) or
@@ -1345,7 +1346,6 @@ implementation
                calcregisters(self,1,1,0)
              else
                calcregisters(self,0,1,0);
-             location.loc:=LOC_FPU;
            end
 
          { if both are orddefs then check sub types }
@@ -1357,11 +1357,12 @@ implementation
                 if not(cs_full_boolean_eval in aktlocalswitches) and
                    (nodetype in [andn,orn]) then
                  begin
-                   calcregisters(self,0,0,0);
                    location.loc:=LOC_JUMP;
+                   calcregisters(self,0,0,0);
                  end
                 else
                  begin
+                   location.loc := LOC_FLAGS;
                    if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and
                       (left.location.loc in [LOC_JUMP,LOC_FLAGS]) then
                      calcregisters(self,2,0,0)
@@ -1375,6 +1376,7 @@ implementation
                begin
                  if nodetype=addn then
                   internalerror(200103291);
+                 location.loc := LOC_FLAGS;
                  calcregisters(self,1,0,0);
                end
               { is there a 64 bit type ? }
@@ -1383,11 +1385,19 @@ implementation
                  result := first_add64bitint;
                  if assigned(result) then
                    exit;
+                  if nodetype in [addn,subn,muln,andn,orn,xorn] then
+                    location.loc := LOC_REGISTER
+                  else
+                    location.loc := LOC_JUMP;
                  calcregisters(self,2,0,0)
                end
              { is there a cardinal? }
              else if (torddef(ld).typ=u32bit) then
                begin
+                  if nodetype in [addn,subn,muln,andn,orn,xorn] then
+                    location.loc := LOC_REGISTER
+                  else
+                    location.loc := LOC_FLAGS;
                  calcregisters(self,1,0,0);
                  { for unsigned mul we need an extra register }
                  if nodetype=muln then
@@ -1395,7 +1405,13 @@ implementation
                end
              { generic s32bit conversion }
              else
-               calcregisters(self,1,0,0);
+               begin
+                  if nodetype in [addn,subn,muln,andn,orn,xorn] then
+                    location.loc := LOC_REGISTER
+                  else
+                    location.loc := LOC_FLAGS;
+                 calcregisters(self,1,0,0);
+               end;
            end
 
          { left side a setdef, must be before string processing,
@@ -1404,22 +1420,22 @@ implementation
            begin
              if tsetdef(ld).settype=smallset then
               begin
+                 location.loc:=LOC_REGISTER;
                  { are we adding set elements ? }
                  if right.nodetype=setelementn then
                    calcregisters(self,2,0,0)
                  else
                    calcregisters(self,1,0,0);
-                 location.loc:=LOC_REGISTER;
               end
              else
               begin
                  result := first_addset;
                  if assigned(result) then
                    exit;
+                 location.loc:=LOC_MEM;
                  calcregisters(self,0,0,0);
                  { here we call SET... }
                  procinfo^.flags:=procinfo^.flags or pi_do_call;
-                 location.loc:=LOC_MEM;
               end;
            end
 
@@ -1486,8 +1502,8 @@ implementation
          { is one a real float ? }
          else if (rd.deftype=floatdef) or (ld.deftype=floatdef) then
             begin
-              calcregisters(self,0,1,0);
               location.loc:=LOC_FPU;
+              calcregisters(self,0,1,0);
             end
 
          { pointer comperation and subtraction }
@@ -1513,8 +1529,8 @@ implementation
          else if ((ld.deftype=procvardef) and (rt=niln)) or
                  ((rd.deftype=procvardef) and (lt=niln)) then
             begin
-              calcregisters(self,1,0,0);
               location.loc:=LOC_REGISTER;
+              calcregisters(self,1,0,0);
             end
 
 {$ifdef SUPPORT_MMX}
@@ -1536,12 +1552,13 @@ implementation
 
          else  if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then
            begin
-             calcregisters(self,1,0,0);
              location.loc:=LOC_REGISTER;
+             calcregisters(self,1,0,0);
            end
 
          else if (ld.deftype=enumdef) then
            begin
+              location.loc := LOC_FLAGS;
               calcregisters(self,1,0,0);
            end
 
@@ -1558,23 +1575,9 @@ implementation
          { the general solution is to convert to 32 bit int }
          else
            begin
-             calcregisters(self,1,0,0);
              location.loc:=LOC_REGISTER;
+             calcregisters(self,1,0,0);
            end;
-
-         case nodetype of
-            ltn,lten,gtn,gten,equaln,unequaln:
-              begin
-                 if is_64bitint(left.resulttype.def) then
-                   location.loc:=LOC_JUMP
-                 else
-                   location.loc:=LOC_FLAGS;
-              end;
-            xorn:
-              begin
-                location.loc:=LOC_REGISTER;
-              end;
-         end;
       end;
 
 begin
@@ -1582,7 +1585,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.39  2001-09-05 15:22:09  jonas
+  Revision 1.40  2001-10-12 13:51:51  jonas
+    * fixed internalerror(10) due to previous fpu overflow fixes ("merged")
+    * fixed bug in n386add (introduced after compilerproc changes for string
+      operations) where calcregisters wasn't called for shortstring addnodes
+    * NOTE: from now on, the location of a binary node must now always be set
+       before you call calcregisters() for it
+
+  Revision 1.39  2001/09/05 15:22:09  jonas
     * made multiplying, dividing and mod'ing of int64 and qword processor
       independent with compilerprocs (+ small optimizations by using shift/and
       where possible)

compiler/nld.pas

@@ -559,6 +559,7 @@ implementation
       begin
         firstpass(left);
         firstpass(right);
+        location.loc := LOC_MEM;
         calcregisters(self,0,0,0);
         result:=nil;
       end;
@@ -734,15 +735,15 @@ implementation
                end;
               include(chp.flags,nf_cargs);
               include(chp.flags,nf_cargswap);
-              calcregisters(chp,0,0,0);
               chp.location.loc:=LOC_MEM;
+              calcregisters(chp,0,0,0);
               chp.resulttype:=htype;
               result:=chp;
               exit;
             end;
          end;
-        calcregisters(self,0,0,0);
         location.loc:=LOC_MEM;
+        calcregisters(self,0,0,0);
       end;
 
 
@@ -800,7 +801,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.25  2001-09-02 21:12:07  peter
+  Revision 1.26  2001-10-12 13:51:51  jonas
+    * fixed internalerror(10) due to previous fpu overflow fixes ("merged")
+    * fixed bug in n386add (introduced after compilerproc changes for string
+      operations) where calcregisters wasn't called for shortstring addnodes
+    * NOTE: from now on, the location of a binary node must now always be set
+       before you call calcregisters() for it
+
+  Revision 1.25  2001/09/02 21:12:07  peter
     * move class of definitions into type section for delphi
 
   Revision 1.24  2001/08/30 15:48:34  jonas

compiler/nmat.pas

@@ -253,6 +253,7 @@ implementation
              result := first_moddiv64bitint;
              if assigned(result) then
                exit;
+             location.loc:=LOC_REGISTER;
              calcregisters(self,2,0,0);
            end
          else
@@ -334,9 +335,8 @@ implementation
 
          if (right.nodetype<>ordconstn) then
           inc(regs);
-         calcregisters(self,regs,0,0);
-
          location.loc:=LOC_REGISTER;
+         calcregisters(self,regs,0,0);
       end;
 
 
@@ -640,7 +640,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.23  2001-09-05 15:22:09  jonas
+  Revision 1.24  2001-10-12 13:51:51  jonas
+    * fixed internalerror(10) due to previous fpu overflow fixes ("merged")
+    * fixed bug in n386add (introduced after compilerproc changes for string
+      operations) where calcregisters wasn't called for shortstring addnodes
+    * NOTE: from now on, the location of a binary node must now always be set
+       before you call calcregisters() for it
+
+  Revision 1.23  2001/09/05 15:22:09  jonas
     * made multiplying, dividing and mod'ing of int64 and qword processor
       independent with compilerprocs (+ small optimizations by using shift/and
       where possible)

compiler/nset.pas

@@ -160,8 +160,8 @@ implementation
          if codegenerror then
           exit;
 
-         calcregisters(self,0,0,0);
          set_location(location,left.location);
+         calcregisters(self,0,0,0);
       end;
 
 
@@ -588,7 +588,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.15  2001-09-02 21:12:07  peter
+  Revision 1.16  2001-10-12 13:51:51  jonas
+    * fixed internalerror(10) due to previous fpu overflow fixes ("merged")
+    * fixed bug in n386add (introduced after compilerproc changes for string
+      operations) where calcregisters wasn't called for shortstring addnodes
+    * NOTE: from now on, the location of a binary node must now always be set
+       before you call calcregisters() for it
+
+  Revision 1.15  2001/09/02 21:12:07  peter
     * move class of definitions into type section for delphi
 
   Revision 1.14  2001/08/26 13:36:43  florian