paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 11:39:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* m68k updates

Browse Source
This commit is contained in:
peter 2001-04-23 18:25:44 +00:00
parent 53c358a713
commit 802acf6940
8 changed files with 254 additions and 2351 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
rtl/i386/rttip.inc
View File

@ -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

201
rtl/inc/genrtti.inc Normal file
View File

@ -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
}

2323
rtl/inc/graph/fontdata.inc
View File

File diff suppressed because it is too large Load Diff

15
rtl/inc/heaptrc.pp
View File

@ -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

13
rtl/inc/int64.inc
View File

@ -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

9
rtl/inc/real2str.inc
View File

@ -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
}

8
rtl/inc/rtti.inc
View File

@ -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

16
rtl/inc/systemh.inc
View File

@ -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