Browse Source

+ qword/int64 type released

florian 26 years ago
parent
commit
404cffaad4
3 changed files with 48 additions and 43 deletions
  1. 9 35
      rtl/inc/int64.inc
  2. 8 1
      rtl/inc/system.inc
  3. 31 7
      rtl/inc/text.inc

+ 9 - 35
rtl/inc/int64.inc

@@ -22,12 +22,6 @@
          high : dword;
          high : dword;
        end;
        end;
 
 
-    procedure int_overflow;
-
-      begin
-         runerror(201);
-      end;
-
     function count_leading_zeros(q : qword) : longint;
     function count_leading_zeros(q : qword) : longint;
 
 
       var
       var
@@ -65,7 +59,7 @@
       begin
       begin
          divqword:=0;
          divqword:=0;
          if n=0 then
          if n=0 then
-           runerror(200); //!!!!!!!!! must push the address
+           HandleErrorFrame(200,get_frame);
          lzz:=count_leading_zeros(z);
          lzz:=count_leading_zeros(z);
          lzn:=count_leading_zeros(n);
          lzn:=count_leading_zeros(n);
          { if the denominator contains less zeros }
          { if the denominator contains less zeros }
@@ -94,7 +88,7 @@
       begin
       begin
          modqword:=0;
          modqword:=0;
          if n=0 then
          if n=0 then
-           runerror(200);   //!!!!!!!!! must push the address
+           HandleErrorFrame(200,get_frame);
          lzz:=count_leading_zeros(z);
          lzz:=count_leading_zeros(z);
          lzn:=count_leading_zeros(n);
          lzn:=count_leading_zeros(n);
          { if the denominator contains less zeros }
          { if the denominator contains less zeros }
@@ -124,7 +118,7 @@
 
 
       begin
       begin
          if n=0 then
          if n=0 then
-           runerror(200); //!!!!!!!!!!!! must get the right address
+           HandleErrorFrame(200,get_frame);
          { can the fpu do the work? }
          { can the fpu do the work? }
          if fpuint64 then
          if fpuint64 then
            //!!!!!!!!!!! divint64:=comp(z)/comp(n)
            //!!!!!!!!!!! divint64:=comp(z)/comp(n)
@@ -184,9 +178,7 @@
          { if one of the operands is greater than the result an }
          { if one of the operands is greater than the result an }
          { overflow occurs                                      }
          { overflow occurs                                      }
          if checkoverflow and ((f1>mulqword) or (f2>mulqword)) then
          if checkoverflow and ((f1>mulqword) or (f2>mulqword)) then
-           begin
-              int_overflow;
-           end;
+           HandleErrorFrame(215,get_frame);
       end;
       end;
 
 
     {    multiplies two int64 ....
     {    multiplies two int64 ....
@@ -232,7 +224,7 @@
                 ((tqwordrec(q3).high and $80000000)<>0) and
                 ((tqwordrec(q3).high and $80000000)<>0) and
                  ((q3<>(qword(1) shl 63)) or not(sign))
                  ((q3<>(qword(1) shl 63)) or not(sign))
                 ) then
                 ) then
-                runerror(202); {!!!!!!!!! must be overflow }
+                HandleErrorFrame(215,get_frame);
 
 
               if sign then
               if sign then
                 mulint64:=-q3
                 mulint64:=-q3
@@ -272,30 +264,12 @@
            int_str(qword(value),s);
            int_str(qword(value),s);
       end;
       end;
 
 
-    { should be moved to text.inc!!!!!!!!! }
-    procedure write_qword(len : longint;{!!!!!var t : textrec;}q : qword);[public,alias:'FPC_WRITE_TEXT_QWORD'];
-
-      var
-         s : string;
-
-      begin
-         {
-         if (InOutRes<>0) then
-           exit;
-         int_str(q,s);
-         write_str(len,t,s);
-         }
-      end;
-
-    procedure read_qword(len : longint;{!!!!!var t : textrec;}q : qword);[public,alias:'FPC_READ_TEXT_QWORD'];
-
-      begin
-         {!!!!!!!!}
-      end;
-
 {
 {
   $Log$
   $Log$
-  Revision 1.9  1999-06-30 22:12:40  florian
+  Revision 1.10  1999-07-01 15:39:50  florian
+    + qword/int64 type released
+
+  Revision 1.9  1999/06/30 22:12:40  florian
     * qword div/mod fixed
     * qword div/mod fixed
     + int64 mod/div/* fully implemented
     + int64 mod/div/* fully implemented
     * int_str(qword) fixed
     * int_str(qword) fixed

+ 8 - 1
rtl/inc/system.inc

@@ -231,6 +231,10 @@ end;
 { Include processor specific routines }
 { Include processor specific routines }
 {$I math.inc}
 {$I math.inc}
 
 
+{$ifdef INT64}
+{$I int64.inc}
+{$endif INT64}
+
 {****************************************************************************
 {****************************************************************************
                             Memory Management
                             Memory Management
 ****************************************************************************}
 ****************************************************************************}
@@ -550,7 +554,10 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.60  1999-06-11 11:47:00  peter
+  Revision 1.61  1999-07-01 15:39:51  florian
+    + qword/int64 type released
+
+  Revision 1.60  1999/06/11 11:47:00  peter
     * random doesn't rte 200 with random(0)
     * random doesn't rte 200 with random(0)
 
 
   Revision 1.59  1999/06/05 20:45:12  michael
   Revision 1.59  1999/06/05 20:45:12  michael

+ 31 - 7
rtl/inc/text.inc

@@ -364,8 +364,6 @@ End;
 
 
 {*****************************************************************************
 {*****************************************************************************
                                Write(Ln)
                                Write(Ln)
-  Remarks:
-     The routines for the int64/qword are in int64.inc
 *****************************************************************************}
 *****************************************************************************}
 
 
 Procedure WriteBuffer(var f:TextRec;var b;len:longint);
 Procedure WriteBuffer(var f:TextRec;var b;len:longint);
@@ -526,6 +524,19 @@ Begin
   Write_Str(Len,t,s);
   Write_Str(Len,t,s);
 End;
 End;
 
 
+{$ifdef INT64}
+    procedure write_qword(len : longint;var t : textrec;q : qword);[public,alias:'FPC_WRITE_TEXT_QWORD'];
+
+      var
+         s : string;
+
+      begin
+         if (InOutRes<>0) then
+           exit;
+         int_str(q,s);
+         write_str(len,t,s);
+      end;
+{$endif INT64}
 
 
 {$ifdef INTERNDOUBLE}
 {$ifdef INTERNDOUBLE}
 
 
@@ -641,9 +652,6 @@ End;
 
 
 {*****************************************************************************
 {*****************************************************************************
                                 Read(Ln)
                                 Read(Ln)
-
-  Remarks:
-     The routines for the int64/qword are in int64.inc
 *****************************************************************************}
 *****************************************************************************}
 
 
 Function NextChar(var f:TextRec;var s:string):Boolean;
 Function NextChar(var f:TextRec;var s:string):Boolean;
@@ -963,6 +971,13 @@ begin
    InOutRes:=106;
    InOutRes:=106;
 end;
 end;
 
 
+{$ifdef INT64}
+    procedure read_qword(len : longint;var t : textrec;q : qword);[public,alias:'FPC_READ_TEXT_QWORD'];
+
+      begin
+         {!!!!!!!!!!!!!}
+      end;
+{$endif INT64}
 
 
 {$else}
 {$else}
 
 
@@ -1103,6 +1118,13 @@ Begin
    InOutRes:=106;
    InOutRes:=106;
 End;
 End;
 
 
+{$ifdef INT64}
+    procedure read_qword(len : longint;var t : textrec;q : qword);[public,alias:'FPC_READ_TEXT_QWORD'];
+
+      begin
+         {!!!!!!!!!!!!!}
+      end;
+{$endif INT64}
 
 
 function ReadRealStr(var f:TextRec):string;
 function ReadRealStr(var f:TextRec):string;
 var
 var
@@ -1155,7 +1177,6 @@ Begin
    InOutRes:=106;
    InOutRes:=106;
 End;
 End;
 
 
-
 {$ifdef SUPPORT_SINGLE}
 {$ifdef SUPPORT_SINGLE}
 Procedure Read_Single(var f : TextRec;var d : single);[Public,Alias:'FPC_READ_TEXT_SINGLE'];
 Procedure Read_Single(var f : TextRec;var d : single);[Public,Alias:'FPC_READ_TEXT_SINGLE'];
 var
 var
@@ -1230,7 +1251,10 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.47  1999-06-30 22:17:24  florian
+  Revision 1.48  1999-07-01 15:39:52  florian
+    + qword/int64 type released
+
+  Revision 1.47  1999/06/30 22:17:24  florian
     + fpuint64 to system unit interface added: if it is true, the rtl
     + fpuint64 to system unit interface added: if it is true, the rtl
       uses the fpu to do int64 operations, if possible
       uses the fpu to do int64 operations, if possible