Browse Source

* fixed type conversions of results of operations with cardinals
(between -dcardinalmulfix)

Jonas Maebe 26 years ago
parent
commit
80f18b22ee
4 changed files with 126 additions and 12 deletions
  1. 17 8
      compiler/cg386add.pas
  2. 11 1
      compiler/options.pas
  3. 68 2
      compiler/tcadd.pas
  4. 30 1
      compiler/tcmat.pas

+ 17 - 8
compiler/cg386add.pas

@@ -848,13 +848,18 @@ implementation
           do_normal:
           do_normal:
                    mboverflow:=false;
                    mboverflow:=false;
                    cmpop:=false;
                    cmpop:=false;
-                   if (p^.left^.resulttype^.deftype=pointerdef) or
-                      (p^.right^.resulttype^.deftype=pointerdef) or
-                      ((p^.left^.resulttype^.deftype=orddef) and
-                       (porddef(p^.left^.resulttype)^.typ=u32bit)) or
-                      ((p^.right^.resulttype^.deftype=orddef) and
-                       (porddef(p^.right^.resulttype)^.typ=u32bit)) then
-                     unsigned:=true;
+{$ifndef cardinalmulfix}
+                   unsigned :=
+                     (p^.left^.resulttype^.deftype=pointerdef) or
+                     (p^.right^.resulttype^.deftype=pointerdef) or
+                     ((p^.left^.resulttype^.deftype=orddef) and
+                      (porddef(p^.left^.resulttype)^.typ=u32bit)) or
+                     ((p^.right^.resulttype^.deftype=orddef) and
+                      (porddef(p^.right^.resulttype)^.typ=u32bit));
+{$else cardinalmulfix}
+                   unsigned := not(is_signed(p^.left^.resulttype)) or
+                               not(is_signed(p^.right^.resulttype));
+{$endif cardinalmulfix}
                    case p^.treetype of
                    case p^.treetype of
                       addn : begin
                       addn : begin
                                if is_set then
                                if is_set then
@@ -2131,7 +2136,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.82  1999-11-06 14:34:17  peter
+  Revision 1.83  1999-12-11 18:53:31  jonas
+    * fixed type conversions of results of operations with cardinals
+      (between -dcardinalmulfix)
+
+  Revision 1.82  1999/11/06 14:34:17  peter
     * truncated log to 20 revs
     * truncated log to 20 revs
 
 
   Revision 1.81  1999/09/28 19:43:45  florian
   Revision 1.81  1999/09/28 19:43:45  florian

+ 11 - 1
compiler/options.pas

@@ -1135,6 +1135,12 @@ begin
   { default on next round }
   { default on next round }
   def_symbol('FPC_USE_CPREFIX');
   def_symbol('FPC_USE_CPREFIX');
 {$endif FPC_USE_CPREFIX}
 {$endif FPC_USE_CPREFIX}
+{$ifdef cardinalmulfix}
+{ for the compiler }
+  def_symbol('CARDINALMULFIX');
+{ for the RTL }
+  def_symbol('CARDINALMULFIXED');
+{$endif cardinalmulfix}
 
 
 { some stuff for TP compatibility }
 { some stuff for TP compatibility }
 {$ifdef i386}
 {$ifdef i386}
@@ -1332,7 +1338,11 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.41  1999-12-10 10:03:54  peter
+  Revision 1.42  1999-12-11 18:53:31  jonas
+    * fixed type conversions of results of operations with cardinals
+      (between -dcardinalmulfix)
+
+  Revision 1.41  1999/12/10 10:03:54  peter
     * fixed parameter orderning
     * fixed parameter orderning
 
 
   Revision 1.40  1999/12/08 10:40:01  pierre
   Revision 1.40  1999/12/08 10:40:01  pierre

+ 68 - 2
compiler/tcadd.pas

@@ -544,9 +544,17 @@ implementation
               if (porddef(rd)^.typ=u32bit) or (porddef(ld)^.typ=u32bit) then
               if (porddef(rd)^.typ=u32bit) or (porddef(ld)^.typ=u32bit) then
                begin
                begin
                  { convert constants to u32bit }
                  { convert constants to u32bit }
+{$ifndef cardinalmulfix}
                  if (porddef(ld)^.typ<>u32bit) then
                  if (porddef(ld)^.typ<>u32bit) then
                   begin
                   begin
                     { s32bit will be used for when the other is also s32bit }
                     { s32bit will be used for when the other is also s32bit }
+
+  { the following line doesn't make any sense: it's the same as        }
+  {  if ((porddef(rd)^.typ=u32bit) or (porddef(ld)^.typ=u32bit)) and   }
+  {      (porddef(ld)^.typ<>u32bit) and (porddef(rd)^.typ=s32bit) then }
+  { which can be simplified to                                         }
+  {  if ((porddef(rd)^.typ=u32bit) and (porddef(rd)^.typ=s32bit) then  }
+  { which can never be true (JM)                                       }
                     if (porddef(rd)^.typ=s32bit) and (lt<>ordconstn) then
                     if (porddef(rd)^.typ=s32bit) and (lt<>ordconstn) then
                      p^.left:=gentypeconvnode(p^.left,s32bitdef)
                      p^.left:=gentypeconvnode(p^.left,s32bitdef)
                     else
                     else
@@ -562,6 +570,31 @@ implementation
                      p^.right:=gentypeconvnode(p^.right,u32bitdef);
                      p^.right:=gentypeconvnode(p^.right,u32bitdef);
                     firstpass(p^.right);
                     firstpass(p^.right);
                   end;
                   end;
+{$else cardinalmulfix}
+                 { only do a conversion if the nodes have different signs }
+                 if (porddef(rd)^.typ=u32bit) xor (porddef(ld)^.typ=u32bit) then
+                   if (porddef(rd)^.typ=u32bit) then
+                     begin
+                     { can we make them both unsigned? }
+                       if is_constintnode(p^.left) and
+                          ((p^.treetype <> subn) and
+                           (p^.left^.value > 0)) then
+                         p^.left:=gentypeconvnode(p^.left,u32bitdef)
+                       else
+                         p^.left:=gentypeconvnode(p^.left,s32bitdef);
+                       firstpass(p^.left);
+                     end
+                   else {if (porddef(ld)^.typ=u32bit) then}
+                     begin
+                     { can we make them both unsigned? }
+                       if is_constintnode(p^.right) and
+                          (p^.right^.value > 0) then
+                         p^.right:=gentypeconvnode(p^.right,u32bitdef)
+                       else
+                         p^.right:=gentypeconvnode(p^.right,s32bitdef);
+                       firstpass(p^.right);
+                     end;
+{$endif cardinalmulfix}
                  calcregisters(p,1,0,0);
                  calcregisters(p,1,0,0);
                  { for unsigned mul we need an extra register }
                  { for unsigned mul we need an extra register }
 {                 p^.registers32:=p^.left^.registers32+p^.right^.registers32; }
 {                 p^.registers32:=p^.left^.registers32+p^.right^.registers32; }
@@ -1176,11 +1209,40 @@ implementation
                  begin
                  begin
                  { for strings, return is always a 255 char string }
                  { for strings, return is always a 255 char string }
                    if is_shortstring(p^.left^.resulttype) then
                    if is_shortstring(p^.left^.resulttype) then
-                    p^.resulttype:=cshortstringdef
+                     p^.resulttype:=cshortstringdef
                    else
                    else
                     p^.resulttype:=p^.left^.resulttype;
                     p^.resulttype:=p^.left^.resulttype;
                  end;
                  end;
               end;
               end;
+{$ifdef cardinalmulfix}
+            muln:
+  { if we multiply an unsigned with a signed number, the result is signed  }
+  { in the other cases, the result remains signed or unsigned depending on }
+  { the multiplication factors (JM)                                        }
+              if (p^.left^.resulttype^.deftype = orddef) and
+                 (p^.right^.resulttype^.deftype = orddef) and
+                 is_signed(p^.right^.resulttype) then
+                p^.resulttype := p^.right^.resulttype
+              else p^.resulttype := p^.left^.resulttype;
+(*
+            subn:
+ { if we substract a u32bit from a positive constant, the result becomes }
+ { s32bit as well (JM)                                                   }
+              begin
+                if (p^.right^.resulttype^.deftype = orddef) and
+                   (p^.left^.resulttype^.deftype = orddef) and
+                   (porddef(p^.right^.resulttype)^.typ = u32bit) and
+                   is_constintnode(p^.left) and
+{                   (porddef(p^.left^.resulttype)^.typ <> u32bit) and}
+                   (p^.left^.value > 0) then
+                  begin
+                    p^.left := gentypeconvnode(p^.left,u32bitdef);
+                    firstpass(p^.left);
+                  end;
+                p^.resulttype:=p^.left^.resulttype;
+              end;
+*)
+{$endif cardinalmulfix}
             else
             else
               p^.resulttype:=p^.left^.resulttype;
               p^.resulttype:=p^.left^.resulttype;
          end;
          end;
@@ -1190,7 +1252,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.60  1999-12-09 23:18:04  pierre
+  Revision 1.61  1999-12-11 18:53:31  jonas
+    * fixed type conversions of results of operations with cardinals
+      (between -dcardinalmulfix)
+
+  Revision 1.60  1999/12/09 23:18:04  pierre
    * no_fast_exit if procedure contains implicit termination code
    * no_fast_exit if procedure contains implicit termination code
 
 
   Revision 1.59  1999/12/01 12:42:33  peter
   Revision 1.59  1999/12/01 12:42:33  peter

+ 30 - 1
compiler/tcmat.pas

@@ -132,6 +132,31 @@ implementation
               firstpass(p^.left);
               firstpass(p^.left);
               firstpass(p^.right);
               firstpass(p^.right);
 
 
+{$ifdef cardinalmulfix}
+{ if we divide a u32bit by a positive constant, the result is also u32bit (JM) }
+              if (p^.left^.resulttype^.deftype = orddef) and
+                 (p^.left^.resulttype^.deftype = orddef) then
+                begin
+                  if (porddef(p^.left^.resulttype)^.typ = u32bit) and
+                     is_constintnode(p^.right) and
+{                     (porddef(p^.right^.resulttype)^.typ <> u32bit) and}
+                     (p^.right^.value > 0) then
+                    begin
+                      p^.right := gentypeconvnode(p^.right,u32bitdef);
+                      firstpass(p^.right);
+                    end;
+{ adjust also the left resulttype if necessary }
+                  if (porddef(p^.right^.resulttype)^.typ = u32bit) and
+                     is_constintnode(p^.left) and
+    {                 (porddef(p^.left^.resulttype)^.typ <> u32bit) and}
+                     (p^.left^.value > 0) then
+                    begin
+                      p^.left := gentypeconvnode(p^.left,u32bitdef);
+                      firstpass(p^.left);
+                    end;
+                end;
+{$endif cardinalmulfix}
+
               { the resulttype depends on the right side, because the left becomes }
               { the resulttype depends on the right side, because the left becomes }
               { always 64 bit                                                      }
               { always 64 bit                                                      }
               p^.resulttype:=p^.right^.resulttype;
               p^.resulttype:=p^.right^.resulttype;
@@ -422,7 +447,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.25  1999-11-30 10:40:58  peter
+  Revision 1.26  1999-12-11 18:53:31  jonas
+    * fixed type conversions of results of operations with cardinals
+      (between -dcardinalmulfix)
+
+  Revision 1.25  1999/11/30 10:40:58  peter
     + ttype, tsymlist
     + ttype, tsymlist
 
 
   Revision 1.24  1999/11/26 13:51:29  pierre
   Revision 1.24  1999/11/26 13:51:29  pierre