* m68k updates

rtl/i386/rttip.inc

@@ -17,6 +17,7 @@
 { I think we should use the pascal version, this code isn't     }
 { much faster                                                   }
 
+{$define FPC_SYSTEM_HAS_FPC_INITIALIZE}
 Procedure Initialize (Data,TypeInfo : pointer);[Public,Alias:'FPC_INITIALIZE'];assembler;
 asm
 // Save registers
@@ -131,6 +132,7 @@ asm
 end;
 
 
+{$define FPC_SYSTEM_HAS_FPC_FINALIZE}
 Procedure int_finalize (Data,TypeInfo: Pointer);[Public,Alias:'FPC_FINALIZE'];assembler;
 asm
         push    %eax
@@ -244,6 +246,7 @@ asm
 end;
 
 
+{$define FPC_SYSTEM_HAS_FPC_ADDREF}
 Procedure Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];Assembler;
 asm
 // Save registers
@@ -358,6 +361,7 @@ asm
 end;
 
 
+{$define FPC_SYSTEM_HAS_FPC_DECREF}
 Procedure DecRef (Data,TypeInfo : Pointer); [Public,alias : 'FPC_DECREF'];Assembler;
 asm
 // Save registers
@@ -470,20 +474,12 @@ asm
         pop     %eax
 end;
 
-procedure FinalizeArray(data,typeinfo : pointer;count,size : longint);
-  [Public,Alias:'FPC_FINALIZEARRAY'];
-
-  var
-     i : longint;
-
-  begin
-     for i:=0 to count-1 do
-       int_finalize(data+size*i,typeinfo);
-  end;
-
 {
   $Log$
-  Revision 1.7  2000-11-09 17:49:34  florian
+  Revision 1.8  2001-04-23 18:25:44  peter
+    * m68k updates
+
+  Revision 1.7  2000/11/09 17:49:34  florian
     + FPC_FINALIZEARRAY
     * Finalize to int_finalize renamed
 

rtl/inc/genrtti.inc

@@ -0,0 +1,201 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by xxxx
+    member of the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ Run-Time type information routines - processor dependent part }
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_INITIALIZE}
+Procedure Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE'];
+
+{ this definition is sometimes (depending on switches)
+  already defined or not so define it locally to avoid problems PM }
+Type
+    Pbyte = ^Byte;
+Var Temp       : PByte;
+    I          : longint;
+    Size,Count : longint;
+    TInfo : Pointer;
+
+begin
+  Temp:=PByte(TypeInfo);
+  case temp^ of
+    tkAstring,tkWstring : PPchar(Data)^:=Nil;
+    tkArray :
+      begin
+      temp:=Temp+1;
+      I:=temp^;
+      temp:=temp+(I+1);               // skip name string;
+      Size:=PArrayRec(Temp)^.Size;     // get element size
+      Count:=PArrayRec(Temp)^.Count;  // get element Count
+      TInfo:=PArrayRec(Temp)^.Info;   // Get element info
+      For I:=0 to Count-1 do
+        Initialize (Data+(I*size),TInfo);
+      end;
+    tkrecord :
+      begin
+      Temp:=Temp+1;
+      I:=Temp^;
+      temp:=temp+(I+1);             // skip name string;
+      Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
+      Count:=PRecRec(Temp)^.Count;  // get element Count
+      For I:=1 to count Do
+        With PRecRec(Temp)^.elements[I] do
+          Initialize (Data+Offset,Info);
+      end;
+  end;
+end;
+{$endif}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_FINALIZE}
+Procedure Finalize (Data,TypeInfo: Pointer);[Public,Alias : 'FPC_FINALIZE'];
+
+{ this definition is sometimes (depending on switches)
+  already defined or not so define it locally to avoid problems PM }
+Type
+    Pbyte = ^Byte;
+Var Temp       : PByte;
+    I          : longint;
+    Size,Count : longint;
+    TInfo : Pointer;
+
+begin
+  Temp:=PByte(TypeInfo);
+  case temp^ of
+    tkAstring,tkWstring : AnsiStr_Decr_Ref(Data);
+    tkArray :
+      begin
+      Temp:=Temp+1;
+      I:=temp^;
+      temp:=temp+(I+1);               // skip name string;
+      Size:=PArrayRec(Temp)^.Size;     // get element size
+      Count:=PArrayRec(Temp)^.Count;  // get element Count
+      TInfo:=PArrayRec(Temp)^.Info;   // Get element info
+      For I:=0 to Count-1 do
+        Finalize (Data+(I*size),TInfo);
+      end;
+    tkrecord :
+      begin
+      Temp:=Temp+1;
+      I:=Temp^;
+      temp:=temp+(I+1);             // skip name string;
+      Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
+      Count:=PRecRec(Temp)^.Count;  // get element Count
+      For I:=1 to count do
+        With PRecRec(Temp)^.elements[I] do
+          Finalize (Data+Offset,Info);
+      end;
+  end;
+end;
+{$endif}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_ADDREF}
+Procedure Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];
+
+{ this definition is sometimes (depending on switches)
+  already defined or not so define it locally to avoid problems PM }
+Type
+    Pbyte = ^Byte;
+Var Temp       : PByte;
+    I          : longint;
+    Size,Count : longint;
+    TInfo : Pointer;
+
+begin
+  Temp:=PByte(TypeInfo);
+  case temp^ of
+    tkAstring,tkWstring : AnsiStr_Incr_Ref(Data);
+    tkArray :
+      begin
+      Temp:=Temp+1;
+      I:=temp^;
+      temp:=temp+(I+1);               // skip name string;
+      Size:=PArrayRec(Temp)^.Size;     // get element size
+      Count:=PArrayRec(Temp)^.Count;  // get element Count
+      TInfo:=PArrayRec(Temp)^.Info;   // Get element info
+      For I:=0 to Count-1 do
+        AddRef (Data+(I*size),TInfo);
+      end;
+    tkrecord :
+      begin
+      Temp:=Temp+1;
+      I:=Temp^;
+      temp:=temp+(I+1);             // skip name string;
+      Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
+      Count:=PRecRec(Temp)^.Count;  // get element Count
+      For I:=1 to count do
+        With PRecRec(Temp)^.elements[I] do
+          AddRef (Data+Offset,Info);
+      end;
+  end;
+end;
+{$endif}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_DECREF}
+Procedure DecRef (Data, TypeInfo : Pointer);[Public,alias : 'FPC_DECREF'];
+{ this definition is sometimes (depending on switches)
+  already defined or not so define it locally to avoid problems PM }
+Type
+    Pbyte = ^Byte;
+Var Temp       : PByte;
+    I          : longint;
+    Size,Count : longint;
+    TInfo : Pointer;
+
+begin
+  Temp:=PByte(TypeInfo);
+  case temp^ of
+    tkAstring,tkWstring : AnsiStr_Decr_Ref(Data);
+    tkArray :
+      begin
+      Temp:=Temp+1;
+      I:=temp^;
+      temp:=temp+(I+1);               // skip name string;
+      Size:=PArrayRec(Temp)^.Size;     // get element size
+      Count:=PArrayRec(Temp)^.Count;  // get element Count
+      TInfo:=PArrayRec(Temp)^.Info;   // Get element info
+      For I:=0 to Count-1 do
+        DecRef (Data+(I*size),TInfo);
+      end;
+    tkrecord :
+      begin
+      Temp:=Temp+1;
+      I:=Temp^;
+      temp:=temp+(I+1);             // skip name string;
+      Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
+      Count:=PRecRec(Temp)^.Count;  // get element Count
+      For I:=1 to count do
+        With PRecRec(Temp)^.elements[I] do
+          DecRef (Data+Offset,Info);
+      end;
+  end;
+end;
+{$endif}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_FINALIZEARRAY}
+procedure FinalizeArray(data,typeinfo : pointer;count,size : longint); [Public,Alias:'FPC_FINALIZEARRAY'];
+  var
+     i : longint;
+  begin
+     for i:=0 to count-1 do
+       int_finalize(data+size*i,typeinfo);
+  end;
+{$endif}
+
+{
+ $Log$
+ Revision 1.2  2001-04-23 18:25:44  peter
+   * m68k updates
+
+}

rtl/inc/heaptrc.pp

@@ -719,7 +719,7 @@ var
    data_end : cardinal;external name '__data_end__';
 {$endif}
 
-procedure CheckPointer(p : pointer);[public, alias : 'FPC_CHECKPOINTER'];
+procedure CheckPointer(p : pointer);[saveregisters, public, alias : 'FPC_CHECKPOINTER'];
 var
   i  : longint;
   pp : pheap_mem_info;
@@ -728,9 +728,6 @@ var
 label
   _exit;
 begin
-  asm
-     pushal
-  end;
   if p=nil then
     goto _exit;
 
@@ -835,11 +832,6 @@ begin
   writeln(ptext^,'pointer $',hexstr(longint(p),8),' does not point to valid memory block');
   runerror(204);
 _exit:
-  asm
-     popal
-     { avoid 386DX popad bug }
-     nop
-  end;
 end;
 
 {*****************************************************************************
@@ -1154,7 +1146,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.12  2001-04-21 12:18:09  peter
+  Revision 1.13  2001-04-23 18:25:44  peter
+    * m68k updates
+
+  Revision 1.12  2001/04/21 12:18:09  peter
     * add nop after popa (merged)
 
   Revision 1.11  2001/04/13 18:05:34  peter

rtl/inc/int64.inc

@@ -115,12 +115,15 @@
       var
          sign : boolean;
          q1,q2 : qword;
+{$ifdef SUPPORT_COMP}
          c : comp;
+{$endif}
 
       begin
          if n=0 then
            HandleErrorFrame(200,get_frame);
          { can the fpu do the work? }
+{$ifdef support_comp}
          if fpuint64 then
            begin
               // the c:=comp(...) is necessary to shut up the compiler
@@ -128,6 +131,7 @@
               divint64:=qword(c);
            end
          else
+{$endif}
            begin
               sign:=false;
               if z<0 then
@@ -262,9 +266,12 @@
       var
          sign : boolean;
          q1,q2,q3 : qword;
+{$ifdef support_comp}
          c : comp;
+{$endif}
 
       begin
+{$ifdef support_comp}
          { can the fpu do the work ? }
          if fpuint64 and not(checkoverflow) then
            begin
@@ -273,6 +280,7 @@
               mulint64:=int64(c);
            end
          else
+{$endif}
            begin
               sign:=false;
               if f1<0 then
@@ -477,7 +485,10 @@
 
 {
   $Log$
-  Revision 1.9  2001-04-13 22:30:04  peter
+  Revision 1.10  2001-04-23 18:25:45  peter
+    * m68k updates
+
+  Revision 1.9  2001/04/13 22:30:04  peter
     * remove warnings
 
   Revision 1.8  2001/03/03 12:39:09  jonas

rtl/inc/real2str.inc

@@ -85,7 +85,7 @@ var
     until carry = 0;
   end;
 
-  procedure getIntPart(d: extended);
+  procedure getIntPart(d: valreal);
   var
     intPartStack: TIntPartStack;
     stackPtr, endStackPtr, digits: longint;
@@ -403,7 +403,10 @@ end;
 
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:45  michael
+  Revision 1.3  2001-04-23 18:25:45  peter
+    * m68k updates
+
+  Revision 1.2  2000/07/13 11:33:45  michael
   + removed logs
- 
+
 }

rtl/inc/rtti.inc

@@ -85,11 +85,17 @@ TArrayRec = record
 
 { The actual Routines are implemented per processor. }
 
+{ Include the cpu dependant part }
 {$i rttip.inc}
+{ Include the generic part }
+{$i genrtti.inc}
 
 {
   $Log$
-  Revision 1.3  2000-10-21 18:20:17  florian
+  Revision 1.4  2001-04-23 18:25:45  peter
+    * m68k updates
+
+  Revision 1.3  2000/10/21 18:20:17  florian
     * a lot of small changes:
        - setlength is internal
        - win32 graph unit extended

rtl/inc/systemh.inc

@@ -76,6 +76,7 @@ Type
   ValReal = Real;
 
   {$define SUPPORT_SINGLE}
+  {$define SUPPORT_DOUBLE}
 {$endif}
 
 { Zero - terminated strings }
@@ -153,14 +154,14 @@ const
 
 { Compatibility With  TP }
 const
+  { code to use comps in int64mul and div code is commented out! (JM) }
+  FPUInt64 : boolean = false; { set this to false if you don't want that }
+                              { the fpu does int64*int64 and             }
+                              { int64 div int64, if the * is overflow    }
+                              { checked, it is done in software          }
 {$ifdef i386}
   Test8086 : byte = 2;       { Always i386 or newer }
   Test8087 : byte = 3;       { Always 387 or newer. Emulated if needed. }
-  { code to use comps in int64mul and div code is commented out! (JM) }
-  FPUInt64 : boolean = false; { set this to false if you don't want that }
-                             { the fpu does int64*int64 and             }
-                             { int64 div int64, if the * is overflow    }
-                             { checked, it is done in software          }
 {$endif i386}
 {$ifdef m68k}
   Test68000 : byte = 0;      { Must be determined at startup for both }
@@ -491,7 +492,10 @@ const
 
 {
   $Log$
-  Revision 1.19  2001-04-13 18:06:07  peter
+  Revision 1.20  2001-04-23 18:25:45  peter
+    * m68k updates
+
+  Revision 1.19  2001/04/13 18:06:07  peter
     * upcase, lowercase for ansistring
 
   Revision 1.18  2001/03/22 23:26:05  florian