Browse Source

* fixed several problems with the int64 constants

florian 25 years ago
parent
commit
60f46dcd29
3 changed files with 57 additions and 23 deletions
  1. 17 10
      compiler/tcadd.pas
  2. 19 12
      compiler/tcmat.pas
  3. 21 1
      compiler/tree.pas

+ 17 - 10
compiler/tcadd.pas

@@ -227,20 +227,24 @@ implementation
              (is_constboolnode(p^.left) and is_constboolnode(p^.right) and
              (is_constboolnode(p^.left) and is_constboolnode(p^.right) and
               (p^.treetype in [ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn]))) then
               (p^.treetype in [ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn]))) then
            begin
            begin
+              { xor, and, or are handled different from arithmetic }
+              { operations regarding the result type               }
               { return a boolean for boolean operations (and,xor,or) }
               { return a boolean for boolean operations (and,xor,or) }
               if is_constboolnode(p^.left) then
               if is_constboolnode(p^.left) then
                resdef:=booldef
                resdef:=booldef
+              else if is_64bitint(rd) or is_64bitint(ld) then
+                resdef:=cs64bitdef
               else
               else
-               resdef:=s32bitdef;
+                resdef:=s32bitdef;
               lv:=p^.left^.value;
               lv:=p^.left^.value;
               rv:=p^.right^.value;
               rv:=p^.right^.value;
               case p^.treetype of
               case p^.treetype of
-                addn : t:=genordinalconstnode(lv+rv,resdef);
-                subn : t:=genordinalconstnode(lv-rv,resdef);
-                muln : t:=genordinalconstnode(lv*rv,resdef);
+                addn : t:=genintconstnode(lv+rv);
+                subn : t:=genintconstnode(lv-rv);
+                muln : t:=genintconstnode(lv*rv);
                 xorn : t:=genordinalconstnode(lv xor rv,resdef);
                 xorn : t:=genordinalconstnode(lv xor rv,resdef);
-                 orn : t:=genordinalconstnode(lv or rv,resdef);
-                andn : t:=genordinalconstnode(lv and rv,resdef);
+                 orn: t:=genordinalconstnode(lv or rv,resdef);
+                andn: t:=genordinalconstnode(lv and rv,resdef);
                  ltn : t:=genordinalconstnode(ord(lv<rv),booldef);
                  ltn : t:=genordinalconstnode(ord(lv<rv),booldef);
                 lten : t:=genordinalconstnode(ord(lv<=rv),booldef);
                 lten : t:=genordinalconstnode(ord(lv<=rv),booldef);
                  gtn : t:=genordinalconstnode(ord(lv>rv),booldef);
                  gtn : t:=genordinalconstnode(ord(lv>rv),booldef);
@@ -451,12 +455,12 @@ implementation
                 end;
                 end;
 (*
 (*
                 { these one can't be in flags! }
                 { these one can't be in flags! }
-                
+
                 Yes they can, secondadd converts the loc_flags to a register.
                 Yes they can, secondadd converts the loc_flags to a register.
                 The typeconversions below are simply removed by firsttypeconv()
                 The typeconversions below are simply removed by firsttypeconv()
                 because the resulttype of p^.left = p^.left^.resulttype
                 because the resulttype of p^.left = p^.left^.resulttype
                 (surprise! :) (JM)
                 (surprise! :) (JM)
-                
+
                 if p^.treetype in [xorn,unequaln,equaln] then
                 if p^.treetype in [xorn,unequaln,equaln] then
                   begin
                   begin
                      if p^.left^.location.loc=LOC_FLAGS then
                      if p^.left^.location.loc=LOC_FLAGS then
@@ -1285,7 +1289,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.4  2000-07-27 09:19:37  jonas
+  Revision 1.5  2000-08-17 12:03:48  florian
+    * fixed several problems with the int64 constants
+
+  Revision 1.4  2000/07/27 09:19:37  jonas
     * removed obsolete typeconversion (it got removed by the compiler in
     * removed obsolete typeconversion (it got removed by the compiler in
       firsttypeconv anyway) (merged from fixes branch)
       firsttypeconv anyway) (merged from fixes branch)
 
 
@@ -1295,4 +1302,4 @@ end.
   Revision 1.2  2000/07/13 11:32:50  michael
   Revision 1.2  2000/07/13 11:32:50  michael
   + removed logs
   + removed logs
 
 
-}
+}

+ 19 - 12
compiler/tcmat.pas

@@ -38,7 +38,7 @@ implementation
       globtype,systems,tokens,
       globtype,systems,tokens,
       cobjects,verbose,globals,
       cobjects,verbose,globals,
       symconst,symtable,aasm,types,
       symconst,symtable,aasm,types,
-      htypechk,pass_1,cpubase,
+      htypechk,pass_1,cpubase,cpuinfo,
 {$ifdef newcg}
 {$ifdef newcg}
       cgbase,
       cgbase,
 {$else newcg}
 {$else newcg}
@@ -54,7 +54,7 @@ implementation
     procedure firstmoddiv(var p : ptree);
     procedure firstmoddiv(var p : ptree);
       var
       var
          t : ptree;
          t : ptree;
-         rv,lv : longint;
+         rv,lv : tconstexprint;
          rd,ld : pdef;
          rd,ld : pdef;
 
 
       begin
       begin
@@ -81,8 +81,10 @@ implementation
          if is_constintnode(p^.left) and is_constintnode(p^.right) then
          if is_constintnode(p^.left) and is_constintnode(p^.right) then
            begin
            begin
               case p^.treetype of
               case p^.treetype of
-                modn : t:=genordinalconstnode(lv mod rv,s32bitdef);
-                divn : t:=genordinalconstnode(lv div rv,s32bitdef);
+                modn:
+                  t:=genintconstnode(lv mod rv);
+                divn:
+                  t:=genintconstnode(lv div rv);
               end;
               end;
               disposetree(p);
               disposetree(p);
               firstpass(t);
               firstpass(t);
@@ -199,8 +201,10 @@ implementation
          if is_constintnode(p^.left) and is_constintnode(p^.right) then
          if is_constintnode(p^.left) and is_constintnode(p^.right) then
            begin
            begin
               case p^.treetype of
               case p^.treetype of
-                 shrn : t:=genordinalconstnode(p^.left^.value shr p^.right^.value,s32bitdef);
-                 shln : t:=genordinalconstnode(p^.left^.value shl p^.right^.value,s32bitdef);
+                 shrn:
+                   t:=genintconstnode(p^.left^.value shr p^.right^.value);
+                 shln:
+                   t:=genintconstnode(p^.left^.value shl p^.right^.value);
               end;
               end;
               disposetree(p);
               disposetree(p);
               firstpass(t);
               firstpass(t);
@@ -256,7 +260,7 @@ implementation
            exit;
            exit;
          if is_constintnode(p^.left) then
          if is_constintnode(p^.left) then
            begin
            begin
-              t:=genordinalconstnode(-p^.left^.value,s32bitdef);
+              t:=genintconstnode(-p^.left^.value);
               disposetree(p);
               disposetree(p);
               firstpass(t);
               firstpass(t);
               p:=t;
               p:=t;
@@ -378,11 +382,11 @@ implementation
          if (p^.left^.treetype=ordconstn) then
          if (p^.left^.treetype=ordconstn) then
            begin
            begin
               if is_boolean(p^.left^.resulttype) then
               if is_boolean(p^.left^.resulttype) then
-               { here we do a boolena(byte(..)) type cast because }
-               { boolean(<int64>) is buggy in 1.00                }
-               t:=genordinalconstnode(byte(not(boolean(byte(p^.left^.value)))),p^.left^.resulttype)
+                { here we do a boolena(byte(..)) type cast because }
+                { boolean(<int64>) is buggy in 1.00                }
+                t:=genordinalconstnode(byte(not(boolean(byte(p^.left^.value)))),p^.left^.resulttype)
               else
               else
-               t:=genordinalconstnode(not(p^.left^.value),p^.left^.resulttype);
+                t:=genordinalconstnode(not(p^.left^.value),p^.left^.resulttype);
               disposetree(p);
               disposetree(p);
               firstpass(t);
               firstpass(t);
               p:=t;
               p:=t;
@@ -479,7 +483,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.3  2000-08-16 13:06:07  florian
+  Revision 1.4  2000-08-17 12:03:48  florian
+    * fixed several problems with the int64 constants
+
+  Revision 1.3  2000/08/16 13:06:07  florian
     + support of 64 bit integer constants
     + support of 64 bit integer constants
 
 
   Revision 1.2  2000/07/13 11:32:52  michael
   Revision 1.2  2000/07/13 11:32:52  michael

+ 21 - 1
compiler/tree.pas

@@ -274,6 +274,9 @@ unit tree;
     function gensinglenode(t : ttreetyp;l : ptree) : ptree;
     function gensinglenode(t : ttreetyp;l : ptree) : ptree;
     function gensubscriptnode(varsym : pvarsym;l : ptree) : ptree;
     function gensubscriptnode(varsym : pvarsym;l : ptree) : ptree;
     function genordinalconstnode(v : TConstExprInt;def : pdef) : ptree;
     function genordinalconstnode(v : TConstExprInt;def : pdef) : ptree;
+    { same as genordinalconstnode, but the resulttype }
+    { is determines automatically                     }
+    function genintconstnode(v : TConstExprInt) : ptree;
     function genpointerconstnode(v : tpointerord;def : pdef) : ptree;
     function genpointerconstnode(v : tpointerord;def : pdef) : ptree;
     function genfixconstnode(v : longint;def : pdef) : ptree;
     function genfixconstnode(v : longint;def : pdef) : ptree;
     function gentypeconvnode(node : ptree;t : pdef) : ptree;
     function gentypeconvnode(node : ptree;t : pdef) : ptree;
@@ -876,6 +879,20 @@ unit tree;
          genordinalconstnode:=p;
          genordinalconstnode:=p;
       end;
       end;
 
 
+    function genintconstnode(v : TConstExprInt) : ptree;
+
+      var
+         i : TConstExprInt;
+
+      begin
+         { we need to bootstrap this code, so it's a little bit messy }
+         i:=2147483647;
+         if (v<=i) and (v>=-i-1) then
+           genintconstnode:=genordinalconstnode(v,s32bitdef)
+         else
+           genintconstnode:=genordinalconstnode(v,cs64bitdef);
+      end;
+
     function genpointerconstnode(v : tpointerord;def : pdef) : ptree;
     function genpointerconstnode(v : tpointerord;def : pdef) : ptree;
 
 
       var
       var
@@ -2133,7 +2150,10 @@ unit tree;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.6  2000-08-16 13:06:07  florian
+  Revision 1.7  2000-08-17 12:03:48  florian
+    * fixed several problems with the int64 constants
+
+  Revision 1.6  2000/08/16 13:06:07  florian
     + support of 64 bit integer constants
     + support of 64 bit integer constants
 
 
   Revision 1.5  2000/08/12 06:46:51  florian
   Revision 1.5  2000/08/12 06:46:51  florian