* qword division fixed

  + code for qword/int64 type casting added:
    range checking isn't implemented yet

compiler/cg386cnv.pas

@@ -175,7 +175,10 @@ implementation
       var
         op      : tasmop;
         opsize    : topsize;
-        hregister : tregister;
+        hregister,
+        hregister2 : tregister;
+        l : pasmlabel;
+
       begin
         { insert range check if not explicit conversion }
         if not(pto^.explizit) then
@@ -192,6 +195,9 @@ implementation
                 2 : pto^.location.register:=makereg16(pfrom^.location.register);
                 4 : pto^.location.register:=makereg32(pfrom^.location.register);
                end;
+               { we can release the upper register }
+               if is_64bitint(pfrom^.resulttype) then
+                 ungetregister32(pfrom^.location.registerhigh);
              end;
           end
 
@@ -206,11 +212,14 @@ implementation
                 ungetiftemp(pfrom^.location.reference);
               end;
 
-            { get op and opsize, handle separate for constants, becuase
+            { get op and opsize, handle separate for constants, because
               movz doesn't support constant values }
             if (pfrom^.location.loc=LOC_MEM) and (pfrom^.location.reference.is_immediate) then
              begin
-               opsize:=def_opsize(pto^.resulttype);
+               if is_64bitint(pto^.resulttype) then
+                 opsize:=S_L
+               else
+                 opsize:=def_opsize(pto^.resulttype);
                op:=A_MOV;
              end
             else
@@ -229,13 +238,24 @@ implementation
               hregister:=getregister32
             else
               hregister:=pfrom^.location.register;
+
             { set the correct register size and location }
             clear_location(pto^.location);
             pto^.location.loc:=LOC_REGISTER;
+
+            { do we need a second register for a 64 bit type ? }
+            if is_64bitint(pto^.resulttype) then
+              begin
+                 hregister2:=getregister32;
+                 pto^.location.registerhigh:=hregister2;
+              end;
             case pto^.resulttype^.size of
-             1 : pto^.location.register:=makereg8(hregister);
-             2 : pto^.location.register:=makereg16(hregister);
-             4 : pto^.location.register:=makereg32(hregister);
+             1:
+               pto^.location.register:=makereg8(hregister);
+             2:
+               pto^.location.register:=makereg16(hregister);
+             4,8:
+               pto^.location.register:=makereg32(hregister);
             end;
             { insert the assembler code }
             if pfrom^.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
@@ -243,6 +263,23 @@ implementation
             else
               exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
                 newreference(pfrom^.location.reference),pto^.location.register)));
+
+            { do we need a sign extension for int64? }
+            if is_64bitint(pto^.resulttype) then
+              begin
+                 exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,
+                   hregister2,hregister2)));
+                 if (porddef(pto^.resulttype)^.typ=s64bitint) then
+                   begin
+                      getlabel(l);
+                      exprasmlist^.concat(new(pai386,op_const_reg(A_TEST,S_L,
+                        $80000000,hregister)));
+                      emitjmp(C_Z,l);
+                      exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,
+                        hregister2)));
+                      emitlab(l);
+                   end;
+              end;
           end;
       end;
 
@@ -1300,7 +1337,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.75  1999-05-31 20:35:46  peter
+  Revision 1.76  1999-06-28 22:29:10  florian
+    * qword division fixed
+    + code for qword/int64 type casting added:
+      range checking isn't implemented yet
+
+  Revision 1.75  1999/05/31 20:35:46  peter
     * ansistring fixes, decr_ansistr called after all temp ansi reuses
 
   Revision 1.74  1999/05/27 19:44:09  peter

compiler/cg386ld.pas

@@ -473,12 +473,22 @@ implementation
                                  1 : opsize:=S_B;
                                  2 : opsize:=S_W;
                                  4 : opsize:=S_L;
+                                 { S_L is correct, the copy is done }
+                                 { with two moves                   }
+                                 8 : opsize:=S_L;
                               end;
                               if loc=LOC_CREGISTER then
                                 begin
                                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
                                     newreference(p^.right^.location.reference),
                                     p^.left^.location.register)));
+                                  if is_64bitint(p^.right^.resulttype) then
+                                    begin
+                                       r:=newreference(p^.right^.location.reference);
+                                       inc(r^.offset,4);
+                                       exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,r,
+                                         p^.left^.location.registerhigh)));
+                                    end;
 {$IfDef regallocfix}
                                   del_reference(p^.right^.location.reference);
 {$EndIf regallocfix}
@@ -488,6 +498,13 @@ implementation
                                   exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize,
                                     p^.right^.location.reference.offset,
                                     newreference(p^.left^.location.reference))));
+                                  if is_64bitint(p^.right^.resulttype) then
+                                    begin
+                                       r:=newreference(p^.left^.location.reference);
+                                       inc(r^.offset,4);
+                                       exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize,
+                                         0,r)));
+                                    end;
 {$IfDef regallocfix}
                                   del_reference(p^.left^.location.reference);
 {$EndIf regallocfix}
@@ -835,7 +852,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.60  1999-05-31 12:42:43  peter
+  Revision 1.61  1999-06-28 22:29:11  florian
+    * qword division fixed
+    + code for qword/int64 type casting added:
+      range checking isn't implemented yet
+
+  Revision 1.60  1999/05/31 12:42:43  peter
     * fixed crash with empty array constructor
 
   Revision 1.59  1999/05/27 19:44:14  peter

compiler/cg386mat.pas

@@ -81,10 +81,6 @@ implementation
               pushusedregisters(pushedreg,$ff
                 and not($80 shr byte(p^.location.registerlow))
                 and not($80 shr byte(p^.location.registerhigh)));
-              if cs_check_overflow in aktlocalswitches then
-                push_int(1)
-              else
-                push_int(0);
               { the left operand is in hloc, because the
                 location of left is p^.location but p^.location
                 is already destroyed
@@ -934,7 +930,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.26  1999-06-02 10:11:44  florian
+  Revision 1.27  1999-06-28 22:29:14  florian
+    * qword division fixed
+    + code for qword/int64 type casting added:
+      range checking isn't implemented yet
+
+  Revision 1.26  1999/06/02 10:11:44  florian
     * make cycle fixed i.e. compilation with 0.99.10
     * some fixes for qword
     * start of register calling conventions

compiler/cgai386.pas

@@ -165,6 +165,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
          1 : o1:=S_B;
          2 : o1:=S_W;
          4 : o1:=S_L;
+         { I don't know if we need it (FK) }
+         8 : o1:=S_L;
         else
          internalerror(78);
         end;
@@ -178,12 +180,13 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                   else
                    o1:=S_W;
                 end;
-            4 : begin
-                  case o1 of
-                   S_B : o1:=S_BL;
-                   S_W : o1:=S_WL;
-                  end;
-                end;
+            4,8:
+              begin
+                 case o1 of
+                    S_B : o1:=S_BL;
+                    S_W : o1:=S_WL;
+                 end;
+              end;
            end;
          end;
         def2def_opsize:=o1;
@@ -1680,6 +1683,13 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
          emitlab(hl);
       end;
 
+    { produces range check code, while one of the operands is a 64 bit
+      integer }
+    procedure emitrangecheck64(p : ptree;todef : pdef);
+
+      begin
+         internalerror(28699);
+      end;
 
      { produces if necessary rangecheckcode }
      procedure emitrangecheck(p:ptree;todef:pdef);
@@ -1711,7 +1721,12 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
         { only check when assigning to scalar, subranges are different,
           when todef=fromdef then the check is always generated }
         fromdef:=p^.resulttype;
-       {we also need lto and hto when checking if we need to use doublebound!
+        if is_64bitint(fromdef) or is_64bitint(todef) then
+          begin
+             emitrangecheck64(p,todef);
+             exit;
+          end;
+        {we also need lto and hto when checking if we need to use doublebound!
         (JM)}
         getrange(todef,lto,hto);
         if todef<>fromdef then
@@ -3088,7 +3103,12 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 end.
 {
   $Log$
-  Revision 1.7  1999-06-17 13:19:50  pierre
+  Revision 1.8  1999-06-28 22:29:15  florian
+    * qword division fixed
+    + code for qword/int64 type casting added:
+      range checking isn't implemented yet
+
+  Revision 1.7  1999/06/17 13:19:50  pierre
    * merged from 0_99_12 branch
 
   Revision 1.5.2.2  1999/06/17 12:38:39  pierre

compiler/msgtxt.inc

@@ -256,7 +256,7 @@ const msgtxt : array[0..000097,1..240] of char=(
   'lowed'#000+
   'W_Label not defined $1'#000+
   'E_Illegal label declaration'#000+
-  'E_GOTO und LABEL are not supported (use switch -Sg)'#000+
+  'E_GOTO and LABEL are not supported (use switch -Sg)'#000+
   'E_Label not found'#000+
   'E_identifier isn'#039't a label'#000+
   'E_label already defined'#000+

compiler/tccnv.pas

@@ -241,13 +241,13 @@ implementation
 
     procedure first_int_to_int(var p : ptree);
       begin
-        if (p^.registers32=0) and
-           (p^.left^.location.loc<>LOC_REGISTER) and
+        if (p^.left^.location.loc<>LOC_REGISTER) and
            (p^.resulttype^.size>p^.left^.resulttype^.size) then
-         begin
-           p^.registers32:=1;
            p^.location.loc:=LOC_REGISTER;
-         end;
+        if is_64bitint(p^.resulttype) then
+          p^.registers32:=max(p^.registers32,2)
+        else
+          p^.registers32:=max(p^.registers32,1);
       end;
 
 
@@ -924,7 +924,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.39  1999-06-28 19:30:07  peter
+  Revision 1.40  1999-06-28 22:29:21  florian
+    * qword division fixed
+    + code for qword/int64 type casting added:
+      range checking isn't implemented yet
+
+  Revision 1.39  1999/06/28 19:30:07  peter
     * merged
 
   Revision 1.35.2.5  1999/06/28 19:07:47  peter

compiler/types.pas

@@ -342,7 +342,7 @@ implementation
          case def^.deftype of
             orddef : begin
                        dt:=porddef(def)^.typ;
-                       is_signed:=(dt in [s8bit,s16bit,s32bit]);
+                       is_signed:=(dt in [s8bit,s16bit,s32bit,s64bitint]);
                      end;
            enumdef : is_signed:=false;
          else
@@ -531,45 +531,62 @@ implementation
     procedure testrange(def : pdef;var l : longint);
       var
          lv,hv: longint;
+
       begin
-         getrange(def,lv,hv);
-         if (def^.deftype=orddef) and
-            (porddef(def)^.typ=u32bit) then
+         { for 64 bit types we need only to check if it is less than }
+         { zero, if def is a qword node                              }
+         if is_64bitint(def) then
            begin
-              if lv<=hv then
+              if (l<0) and (porddef(def)^.typ=u64bit) then
                 begin
-                   if (l<lv) or (l>hv) then
+                   l:=0;
+                   if (cs_check_range in aktlocalswitches) then
+                     Message(parser_e_range_check_error)
+                   else
+                     Message(parser_w_range_check_error);
+                end;
+           end
+         else
+           begin
+              getrange(def,lv,hv);
+              if (def^.deftype=orddef) and
+                 (porddef(def)^.typ=u32bit) then
+                begin
+                   if lv<=hv then
+                     begin
+                        if (l<lv) or (l>hv) then
+                          begin
+                             if (cs_check_range in aktlocalswitches) then
+                               Message(parser_e_range_check_error)
+                             else
+                               Message(parser_w_range_check_error);
+                          end;
+                     end
+                   else
+                     { this happens with the wrap around problem  }
+                     { if lv is positive and hv is over $7ffffff  }
+                     { so it seems negative                       }
                      begin
-                        if (cs_check_range in aktlocalswitches) then
-                          Message(parser_e_range_check_error)
-                        else
-                          Message(parser_w_range_check_error);
+                        if ((l>=0) and (l<lv)) or
+                           ((l<0) and (l>hv)) then
+                          begin
+                             if (cs_check_range in aktlocalswitches) then
+                               Message(parser_e_range_check_error)
+                             else
+                               Message(parser_w_range_check_error);
+                          end;
                      end;
                 end
-              else
-                { this happens with the wrap around problem  }
-                { if lv is positive and hv is over $7ffffff  }
-                { so it seems negative                       }
+              else if (l<lv) or (l>hv) then
                 begin
-                   if ((l>=0) and (l<lv)) or
-                      ((l<0) and (l>hv)) then
-                     begin
-                        if (cs_check_range in aktlocalswitches) then
-                          Message(parser_e_range_check_error)
-                        else
-                          Message(parser_w_range_check_error);
-                     end;
+                   if (def^.deftype=enumdef) or
+                      (cs_check_range in aktlocalswitches) then
+                     Message(parser_e_range_check_error)
+                   else
+                     Message(parser_w_range_check_error);
+                   { Fix the value to be in range }
+                   l:=lv+(l mod (hv-lv+1));
                 end;
-           end
-         else if (l<lv) or (l>hv) then
-           begin
-              if (def^.deftype=enumdef) or
-                 (cs_check_range in aktlocalswitches) then
-                Message(parser_e_range_check_error)
-              else
-                Message(parser_w_range_check_error);
-              { Fix the value to be in range }
-              l:=lv+(l mod (hv-lv+1));
            end;
       end;
 
@@ -930,7 +947,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.72  1999-06-13 22:41:08  peter
+  Revision 1.73  1999-06-28 22:29:22  florian
+    * qword division fixed
+    + code for qword/int64 type casting added:
+      range checking isn't implemented yet
+
+  Revision 1.72  1999/06/13 22:41:08  peter
     * merged from fixes
 
   Revision 1.71.2.1  1999/06/13 22:37:17  peter