mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-02 13:39:38 +01:00
* several fixes for linux/powerpc
* several fixes to MT
This commit is contained in:
florian
parent
046ee7bf2b
commit
7ac5c3743d
@ -10,16 +10,41 @@ type
|
||||
longint=$80000000..$7fffffff;
|
||||
pchar=^char;
|
||||
|
||||
var
|
||||
a,b,c,d : longint;
|
||||
s1,s2 : string;
|
||||
i1,i2 : int64;
|
||||
|
||||
implementation
|
||||
|
||||
{ $i ../powerpc/powerpc.inc}
|
||||
|
||||
{
|
||||
procedure p1(l1,l2,l3 : longint);
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure do_exit;[public,alias:'FPC_DO_EXIT'];
|
||||
begin
|
||||
end;
|
||||
}
|
||||
|
||||
begin
|
||||
b:=4;
|
||||
a:=b;
|
||||
i1:=i2;
|
||||
// p1(a,b,3);
|
||||
// s1:=s2;
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-07-13 11:33:38 michael
|
||||
Revision 1.3 2002-07-28 20:43:47 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.2 2000/07/13 11:33:38 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
|
||||
@ -256,7 +256,11 @@ Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;var Buf); compiler
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.16 2002-04-25 20:14:56 peter
|
||||
Revision 1.17 2002-07-28 20:43:47 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.16 2002/04/25 20:14:56 peter
|
||||
* updated compilerprocs
|
||||
* incr ref count has now a value argument instead of var
|
||||
|
||||
@ -362,5 +366,4 @@ Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;var Buf); compiler
|
||||
chars)
|
||||
* fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is
|
||||
still nil (used to crash, now return resp -1 and 0)
|
||||
|
||||
}
|
||||
|
||||
@ -33,7 +33,7 @@ begin
|
||||
for i:=0 to count do
|
||||
bytearray(dest)[i]:=bytearray(source)[i];
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_MOVE}
|
||||
{$endif not FPC_SYSTEM_HAS_MOVE}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
|
||||
@ -53,7 +53,7 @@ begin
|
||||
for i:=(count div 4)*4 to count-1 do
|
||||
bytearray(x)[i]:=value;
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_FILLCHAR}
|
||||
{$endif FPC_SYSTEM_HAS_FILLCHAR}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FILLBYTE}
|
||||
@ -61,7 +61,7 @@ procedure FillByte (var x;count : longint;value : byte );
|
||||
begin
|
||||
FillChar (X,Count,CHR(VALUE));
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_FILLBYTE}
|
||||
{$endif not FPC_SYSTEM_HAS_FILLBYTE}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FILLWORD}
|
||||
@ -78,7 +78,7 @@ begin
|
||||
for i:=(count div 2)*2 to count-1 do
|
||||
wordarray(x)[i]:=value;
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_FILLWORD}
|
||||
{$endif not FPC_SYSTEM_HAS_FILLWORD}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FILLDWORD}
|
||||
@ -98,7 +98,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_FILLDWORD}
|
||||
{$endif FPC_SYSTEM_HAS_FILLDWORD}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_INDEXCHAR}
|
||||
@ -106,7 +106,7 @@ function IndexChar(Const buf;len:longint;b:char):longint;
|
||||
begin
|
||||
IndexChar:=IndexByte(Buf,Len,byte(B));
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_INDEXCHAR}
|
||||
{$endif not FPC_SYSTEM_HAS_INDEXCHAR}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
|
||||
@ -123,7 +123,7 @@ begin
|
||||
i:=-1; {Can't use 0, since it is a possible value}
|
||||
IndexByte:=I;
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_INDEXBYTE}
|
||||
{$endif not FPC_SYSTEM_HAS_INDEXBYTE}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_INDEXWORD}
|
||||
@ -140,7 +140,7 @@ begin
|
||||
i:=-1; {Can't use 0, since it is a possible value for index}
|
||||
Indexword:=I;
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_INDEXWORD}
|
||||
{$endif not FPC_SYSTEM_HAS_INDEXWORD}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
|
||||
@ -156,7 +156,7 @@ begin
|
||||
i:=-1; {Can't use 0, since it is a possible value for index}
|
||||
IndexDWord:=I;
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_INDEXDWORD}
|
||||
{$endif not FPC_SYSTEM_HAS_INDEXDWORD}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_COMPARECHAR}
|
||||
@ -164,7 +164,7 @@ function CompareChar(Const buf1,buf2;len:longint):longint;
|
||||
begin
|
||||
CompareChar:=CompareByte(buf1,buf2,len);
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_COMPARECHAR}
|
||||
{$endif not FPC_SYSTEM_HAS_COMPARECHAR}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
|
||||
@ -193,7 +193,7 @@ begin
|
||||
end;
|
||||
CompareByte:=I;
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_COMPAREBYTE}
|
||||
{$endif not FPC_SYSTEM_HAS_COMPAREBYTE}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
|
||||
@ -222,7 +222,7 @@ begin
|
||||
end;
|
||||
CompareWord:=I;
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_COMPAREWORD}
|
||||
{$endif not FPC_SYSTEM_HAS_COMPAREWORD}
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
|
||||
@ -316,7 +316,7 @@ begin
|
||||
end;
|
||||
CompareChar0:=I;
|
||||
end;
|
||||
{$endif ndef FPC_SYSTEM_HAS_COMPARECHAR0}
|
||||
{$endif not FPC_SYSTEM_HAS_COMPARECHAR0}
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
@ -362,7 +362,7 @@ begin
|
||||
fpc_help_constructor:=_self;
|
||||
end;
|
||||
|
||||
{$endif ndef FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
|
||||
{$endif FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
|
||||
|
||||
@ -391,7 +391,7 @@ begin
|
||||
_self:=nil;
|
||||
end;
|
||||
|
||||
{$endif ndef FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
|
||||
{$endif FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FPC_HELP_FAIL}
|
||||
procedure fpc_help_fail(var _self : pointer; var vmt : pointer; vmt_pos : cardinal);safecall; [public,alias:'FPC_HELP_FAIL'];
|
||||
@ -455,7 +455,7 @@ procedure fpc_dispose_class(_self: tobject; flag : longint);saveregisters;[publi
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
|
||||
|
||||
procedure fpc_check_object(vmt : pointer);saveregisters;[public,alias:'FPC_CHECK_OBJECT']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
procedure fpc_check_object(obj : pointer);saveregisters;[public,alias:'FPC_CHECK_OBJECT']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
type
|
||||
pvmt = ^tvmt;
|
||||
tvmt = packed record
|
||||
@ -555,8 +555,6 @@ begin
|
||||
}
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY}
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
|
||||
@ -770,7 +768,7 @@ begin
|
||||
abs:=l;
|
||||
end;
|
||||
|
||||
{$endif ndef FPC_SYSTEM_HAS_ABS_LONGINT}
|
||||
{$endif not FPC_SYSTEM_HAS_ABS_LONGINT}
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_ODD_LONGINT}
|
||||
|
||||
@ -947,7 +945,11 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.27 2002-06-16 08:19:03 carl
|
||||
Revision 1.28 2002-07-28 20:43:47 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.27 2002/06/16 08:19:03 carl
|
||||
* bugfix of FPC_NEW_CLASS (was not creating correct instance)
|
||||
+ FPC_HELP_FAIL_CLASS now tested (no longer required)
|
||||
|
||||
|
||||
@ -988,6 +988,7 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
|
||||
Helper routines to support old TP styled reals
|
||||
****************************************************************************}
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_REAL2DOUBLE}
|
||||
function real2double(r : real48) : double;
|
||||
|
||||
var
|
||||
@ -1014,11 +1015,16 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
|
||||
res[7]:=res[7] or (r[5] and $80);
|
||||
real2double:=double(res);
|
||||
end;
|
||||
{$endif}
|
||||
{$endif FPC_SYSTEM_HAS_REAL2DOUBLE}
|
||||
{$endif SUPPORT_DOUBLE}
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2001-12-26 21:03:56 peter
|
||||
Revision 1.4 2002-07-28 20:43:48 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.3 2001/12/26 21:03:56 peter
|
||||
* merged fixes from 1.0.x
|
||||
|
||||
Revision 1.2 2001/07/30 21:38:55 peter
|
||||
@ -1026,6 +1032,4 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
|
||||
|
||||
Revision 1.1.2.1 2001/07/29 23:58:16 carl
|
||||
+ generic version of mathematical routines (taken from m68k directory)
|
||||
|
||||
|
||||
}
|
||||
|
||||
@ -203,11 +203,13 @@ begin
|
||||
D:=real2double(b);
|
||||
end;
|
||||
|
||||
{$ifdef SUPPORT_EXTENDED}
|
||||
operator := (b:real48) e:extended;
|
||||
|
||||
begin
|
||||
e:=real2double(b);
|
||||
end;
|
||||
{$endif SUPPORT_EXTENDED}
|
||||
|
||||
{ Include processor specific routines }
|
||||
{$I math.inc}
|
||||
@ -755,7 +757,11 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.31 2002-07-26 22:46:06 florian
|
||||
Revision 1.32 2002-07-28 20:43:48 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.31 2002/07/26 22:46:06 florian
|
||||
* interface of system unit for Linux/PowerPC compiles
|
||||
|
||||
Revision 1.30 2002/07/26 16:42:00 florian
|
||||
|
||||
@ -24,6 +24,10 @@ type
|
||||
function BeginThread(sa : Pointer;stacksize : dword;
|
||||
ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;
|
||||
var ThreadId : DWord) : DWord;
|
||||
{ Delphi uses a longint for threadid }
|
||||
function BeginThread(sa : Pointer;stacksize : dword;
|
||||
ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;
|
||||
var ThreadId : Longint) : DWord;
|
||||
|
||||
{ add some simplfied forms which make lifer easier and porting }
|
||||
{ to other OSes too ... }
|
||||
@ -31,6 +35,8 @@ function BeginThread(ThreadFunction : tthreadfunc) : DWord;
|
||||
function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : DWord;
|
||||
function BeginThread(ThreadFunction : tthreadfunc;p : pointer;
|
||||
var ThreadId : DWord) : DWord;
|
||||
function BeginThread(ThreadFunction : tthreadfunc;p : pointer;
|
||||
var ThreadId : Longint) : DWord;
|
||||
|
||||
procedure EndThread(ExitCode : DWord);
|
||||
procedure EndThread;
|
||||
@ -47,7 +53,11 @@ procedure LeaveCriticalsection(var cs : TRTLCriticalSection);
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2001-10-23 21:51:03 peter
|
||||
Revision 1.6 2002-07-28 20:43:48 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.5 2001/10/23 21:51:03 peter
|
||||
* criticalsection renamed to rtlcriticalsection for kylix compatibility
|
||||
|
||||
Revision 1.4 2001/01/26 16:37:54 florian
|
||||
|
||||
@ -88,7 +88,7 @@ type
|
||||
status: cardinal;
|
||||
end;
|
||||
|
||||
{$Ifdef i386}
|
||||
{$ifdef i386}
|
||||
PSigContextRec = ^SigContextRec;
|
||||
SigContextRec = record
|
||||
gs, __gsh: word;
|
||||
@ -114,14 +114,21 @@ type
|
||||
oldmask: cardinal;
|
||||
cr2: cardinal;
|
||||
end;
|
||||
{$ENDIF}
|
||||
{$endif i386}
|
||||
|
||||
{$Ifdef m68k}
|
||||
PSigContextRec = ^SigContextRec;
|
||||
SigContextRec = record
|
||||
{ dummy for now PM }
|
||||
end;
|
||||
{$ENDIF}
|
||||
{$endif m68k}
|
||||
|
||||
{$ifdef powerpc}
|
||||
PSigContextRec = ^SigContextRec;
|
||||
SigContextRec = record
|
||||
{ dummy for now PM }
|
||||
end;
|
||||
{$endif powerpc}
|
||||
|
||||
(*
|
||||
PSigInfoRec = ^SigInfoRec;
|
||||
@ -192,7 +199,11 @@ type
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2001-06-27 21:37:38 peter
|
||||
Revision 1.5 2002-07-28 20:43:48 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.4 2001/06/27 21:37:38 peter
|
||||
* v10 merges
|
||||
|
||||
Revision 1.3 2001/04/04 22:50:59 peter
|
||||
|
||||
@ -32,6 +32,7 @@ Procedure Do_SysCall( callnr:longint;var regs : SysCallregs );assembler;
|
||||
}
|
||||
{$ifdef i386}
|
||||
{$ASMMODE ATT}
|
||||
{$define fpc_syscall_ok}
|
||||
asm
|
||||
{ load the registers... }
|
||||
movl 12(%ebp),%eax
|
||||
@ -56,8 +57,9 @@ asm
|
||||
movl %ebx,(%eax)
|
||||
end;
|
||||
{$ASMMODE DEFAULT}
|
||||
{$else}
|
||||
{$endif i386}
|
||||
{$ifdef m68k}
|
||||
{$define fpc_syscall_ok}
|
||||
asm
|
||||
{ load the registers... }
|
||||
move.l 12(a6),a0
|
||||
@ -81,10 +83,12 @@ asm
|
||||
move.l (sp)+,d1
|
||||
move.l d1,(a0)
|
||||
end;
|
||||
{$else}
|
||||
{$error Cannot decide which processor you have ! define i386 or m68k }
|
||||
{$endif}
|
||||
{$endif}
|
||||
{$endif m68k}
|
||||
{$ifndef fpc_syscall_ok}
|
||||
{$error Cannot decide which processor you have!}
|
||||
asm
|
||||
end;
|
||||
{$endif not fpc_syscall_ok}
|
||||
|
||||
{$IFDEF SYSCALL_DEBUG}
|
||||
Const
|
||||
@ -554,7 +558,11 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2001-10-14 13:33:20 peter
|
||||
Revision 1.6 2002-07-28 20:43:48 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.5 2001/10/14 13:33:20 peter
|
||||
* start of thread support for linux
|
||||
|
||||
Revision 1.4 2001/06/02 00:31:30 peter
|
||||
|
||||
@ -20,15 +20,22 @@
|
||||
EXTENDED data type routines
|
||||
****************************************************************************}
|
||||
|
||||
{$define FPC_SYSTEM_HAS_PI}
|
||||
function pi : double;[internconst:in_pi];
|
||||
begin
|
||||
pi := 3.14159265358979320;
|
||||
end;
|
||||
|
||||
{$define FPC_SYSTEM_HAS_ABS}
|
||||
function abs(d : extended) : extended;[internproc:in_abs_extended];
|
||||
|
||||
{$define FPC_SYSTEM_HAS_SQR}
|
||||
function sqr(d : extended) : extended;[internproc:in_sqr_extended];
|
||||
|
||||
{$define FPC_SYSTEM_HAS_SQRT}
|
||||
function sqrt(d : extended) : extended;[internproc:in_sqrt_extended];
|
||||
|
||||
{
|
||||
function arctan(d : extended) : extended;[internconst:in_arctan_extended];
|
||||
begin
|
||||
runerror(207);
|
||||
@ -49,25 +56,27 @@
|
||||
runerror(207);
|
||||
end;
|
||||
|
||||
function exp(d : extended) : extended;assembler;[internconst:in_const_exp];
|
||||
function exp(d : extended) : extended;[internconst:in_const_exp];
|
||||
begin
|
||||
runerror(207);
|
||||
end;
|
||||
|
||||
|
||||
function frac(d : extended) : extended;assembler;[internconst:in_const_frac];
|
||||
function frac(d : extended) : extended;[internconst:in_const_frac];
|
||||
begin
|
||||
runerror(207);
|
||||
end;
|
||||
|
||||
|
||||
function int(d : extended) : extended;assembler;[internconst:in_const_int];
|
||||
function int(d : extended) : extended;[internconst:in_const_int];
|
||||
begin
|
||||
runerror(207);
|
||||
end;
|
||||
}
|
||||
|
||||
|
||||
function trunc(d : extended) : longint;assembler;[internconst:in_const_trunc];
|
||||
{$define FPC_SYSTEM_HAS_TRUNC}
|
||||
{$warning FIX ME}
|
||||
function trunc(d : extended) : int64;assembler;[internconst:in_const_trunc];
|
||||
{ input: d in fr1 }
|
||||
{ output: result in r3 }
|
||||
assembler;
|
||||
@ -82,9 +91,11 @@
|
||||
fctiwz fr1,fr1
|
||||
stfd fr1,temp.d
|
||||
lwz r3,temp.l2
|
||||
end ['r3','fr1'];
|
||||
// !!!! fix int64 result
|
||||
end ['r3','f1'];
|
||||
|
||||
|
||||
{$define FPC_SYSTEM_HAS_ROUND}
|
||||
function round(d : extended) : longint;assembler;[internconst:in_const_round];
|
||||
{ input: d in fr1 }
|
||||
{ output: result in r3 }
|
||||
@ -100,9 +111,10 @@
|
||||
fctiw fr1,fr1
|
||||
stfd fr1,temp.d
|
||||
lwz r3,temp.l2
|
||||
end ['r3','fr1'];
|
||||
end ['r3','f1'];
|
||||
|
||||
|
||||
{$define FPC_SYSTEM_HAS_POWER}
|
||||
function power(bas,expo : extended) : extended;
|
||||
begin
|
||||
if bas=0 then
|
||||
@ -158,6 +170,7 @@
|
||||
|
||||
{ warning: the following converts a little-endian TP-style real }
|
||||
{ to a big-endian double. So don't byte-swap the TP real! }
|
||||
{$define FPC_SYSTEM_HAS_REAL2DOUBLE}
|
||||
function real2double(r : real48) : double;
|
||||
|
||||
var
|
||||
@ -218,7 +231,7 @@ asm
|
||||
lfd fr2,int_to_real_factor@l(r3)
|
||||
fsub fr3,fr3,fr1
|
||||
fmadd fr1,fr0,fr2,fr3
|
||||
end ['r0','r3','r4','fr0','fr1','fr2','fr3'];
|
||||
end ['r0','r3','r4','f0','f1','f2','f3'];
|
||||
|
||||
|
||||
function fpc_qword_to_real(q: qword): double; compilerproc;
|
||||
@ -246,13 +259,17 @@ asm
|
||||
lfd fr2,int_to_real_factor@l(r3)
|
||||
fsub fr3,fr3,fr1
|
||||
fmadd fr1,fr0,fr2,fr3
|
||||
end ['r0','r3','fr0','fr1','fr2','fr3'];
|
||||
end ['r0','r3','f0','f1','f2','f3'];
|
||||
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2001-12-02 16:19:45 jonas
|
||||
Revision 1.4 2002-07-28 20:43:49 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.3 2001/12/02 16:19:45 jonas
|
||||
* fpu results are returned in fr1, not fr0
|
||||
|
||||
Revision 1.2 2001/10/30 17:18:14 jonas
|
||||
@ -262,6 +279,4 @@ end ['r0','r3','fr0','fr1','fr2','fr3'];
|
||||
|
||||
Revision 1.1 2001/10/28 14:09:13 jonas
|
||||
+ initial implementation, lots of things still missing
|
||||
|
||||
|
||||
}
|
||||
|
||||
@ -311,7 +311,6 @@ end;
|
||||
|
||||
|
||||
{$define FPC_SYSTEM_HAS_FILLWORD}
|
||||
|
||||
procedure fillword(var x;count : longint;value : word);
|
||||
begin
|
||||
{ registers:
|
||||
@ -337,7 +336,7 @@ begin
|
||||
stwux r5,r13,r14
|
||||
bdnz .FillWordLoop
|
||||
.FillWordEnd:
|
||||
end [r13,r14,ctr]
|
||||
end ['r13','r14','ctr']
|
||||
end;
|
||||
|
||||
|
||||
@ -527,17 +526,20 @@ end ['r0','r3','r4','r9','r10','cr0','ctr'];
|
||||
Object Helpers
|
||||
****************************************************************************}
|
||||
|
||||
{define FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
|
||||
(*
|
||||
use generic implementation for now
|
||||
procedure fpc_help_constructor; assembler; [public,alias:'FPC_HELP_CONSTRUCTOR']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
*)
|
||||
{ use generic implementation for now }
|
||||
{ that's a problem currently, the generic has a another prototy than this defined in compproc.inc (FK) }
|
||||
|
||||
{$define FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
|
||||
procedure fpc_help_constructor; assembler;compilerproc;
|
||||
asm
|
||||
end;
|
||||
|
||||
{$define FPC_SYSTEM_HAS_FPC_HELP_FAIL}
|
||||
procedure fpc_help_fail;assembler;[public,alias:'FPC_HELP_FAIL']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
assembler
|
||||
assembler;
|
||||
asm
|
||||
!!!!!!!!!!!
|
||||
{$warning FIX ME!}
|
||||
// !!!!!!!!!!!
|
||||
end;
|
||||
|
||||
|
||||
@ -551,7 +553,8 @@ procedure fpc_help_destructor;assembler;[public,alias:'FPC_HELP_DESTRUCTOR']; {$
|
||||
procedure fpc_new_class;assembler;[public,alias:'FPC_NEW_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
assembler;
|
||||
asm
|
||||
!!!!!!!!!!!
|
||||
{$warning FIX ME!}
|
||||
// !!!!!!!!!!!
|
||||
end;
|
||||
|
||||
|
||||
@ -559,7 +562,8 @@ end;
|
||||
procedure fpc_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
assembler;
|
||||
asm
|
||||
!!!!!!!!!!!
|
||||
{$warning FIX ME!}
|
||||
// !!!!!!!!!!!
|
||||
end;
|
||||
|
||||
{$define FPC_SYSTEM_HAS_FPC_HELP_FAIL_CLASS}
|
||||
@ -568,7 +572,8 @@ procedure fpc_help_fail_class;assembler;[public,alias:'FPC_HELP_FAIL_CLASS']; {$
|
||||
VMT is allways at pos 0 }
|
||||
assembler;
|
||||
asm
|
||||
!!!!!!!!!!!
|
||||
{$warning FIX ME!}
|
||||
// !!!!!!!!!!!
|
||||
end;
|
||||
|
||||
|
||||
@ -580,11 +585,12 @@ use generic implementation for now
|
||||
procedure fpc_check_object(obj : pointer);[public,alias:'FPC_CHECK_OBJECT']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
*)
|
||||
|
||||
{define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
|
||||
(*
|
||||
use generic implementation for now
|
||||
procedure fpc_check_object_ext;assembler;[public,alias:'FPC_CHECK_OBJECT_EXT']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
*)
|
||||
{ use generic implementation for now }
|
||||
{ that's a problem currently, the generic has a another prototy than this defined in compproc.inc (FK) }
|
||||
{$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
|
||||
procedure fpc_check_object_ext; compilerproc;assembler;
|
||||
asm
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
String
|
||||
@ -645,8 +651,8 @@ LShortStrCopyLoop:
|
||||
bdnz LShortStrCopyLoop
|
||||
end ['r0','r3','r4','r5','r10','cr0','ctr'];
|
||||
|
||||
|
||||
function fpc_shortstr_concat(const s1: shortstring): shortstring; compilerproc;
|
||||
{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
|
||||
function fpc_shortstr_concat(const s1,s2: shortstring): shortstring; compilerproc;
|
||||
{ expects that results (r3) contains a pointer to the current string and s1 }
|
||||
{ (r4) a pointer to the one that has to be concatenated }
|
||||
assembler;
|
||||
@ -743,21 +749,24 @@ function strlen(p:pchar):longint;assembler;
|
||||
{$define FPC_SYSTEM_HAS_GET_FRAME}
|
||||
function get_frame:longint;assembler;
|
||||
asm
|
||||
!!!!!!! depends on ABI !!!!!!!!
|
||||
{$warning FIX ME!}
|
||||
// !!!!!!! depends on ABI !!!!!!!!
|
||||
end ['r3'];
|
||||
|
||||
|
||||
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
|
||||
function get_caller_addr(framebp:longint):longint;assembler;
|
||||
asm
|
||||
!!!!!!! depends on ABI !!!!!!!!
|
||||
{$warning FIX ME!}
|
||||
// !!!!!!! depends on ABI !!!!!!!!
|
||||
end ['r3'];
|
||||
|
||||
|
||||
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
|
||||
function get_caller_frame(framebp:longint):longint;assembler;
|
||||
asm
|
||||
!!!!!!! depends on ABI !!!!!!!!
|
||||
{$warning FIX ME!}
|
||||
// !!!!!!! depends on ABI !!!!!!!!
|
||||
end ['r3'];
|
||||
|
||||
{$define FPC_SYSTEM_HAS_ABS_LONGINT}
|
||||
@ -826,6 +835,7 @@ LDecLockedLoop:
|
||||
end ['r3','r10'];
|
||||
|
||||
procedure inclocked(var l : longint);assembler;
|
||||
asm
|
||||
LIncLockedLoop:
|
||||
{$ifdef MT}
|
||||
lwarx r10,0,r3
|
||||
@ -842,7 +852,11 @@ end ['r3','r10'];
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 2002-07-26 15:45:56 florian
|
||||
Revision 1.9 2002-07-28 20:43:49 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.8 2002/07/26 15:45:56 florian
|
||||
* changed multi threading define: it's MT instead of MTRTL
|
||||
|
||||
Revision 1.7 2001/09/28 13:28:49 jonas
|
||||
@ -876,5 +890,4 @@ end ['r3','r10'];
|
||||
|
||||
Revision 1.1 2000/07/27 07:32:12 jonas
|
||||
+ initial version by Casey Duncan (not yet thoroughly debugged or complete)
|
||||
|
||||
}
|
||||
|
||||
23
rtl/powerpc/rttip.inc
Normal file
23
rtl/powerpc/rttip.inc
Normal file
@ -0,0 +1,23 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 2002 by Jonas Maebe and other members of the
|
||||
Free Pascal development team
|
||||
|
||||
Implementation of processor optimized RTTI code
|
||||
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2002-07-28 20:43:49 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
}
|
||||
@ -193,7 +193,8 @@ Lset_range_exit:
|
||||
end ['r0','r3','r4','r5','r6','r9','r10','cr0','ctr'];
|
||||
|
||||
|
||||
function fpc_set_in_byte(const p: fpc_normal_set; b : byte): boolean;assembler;[public,alias:'FPC_SET_IN_BYTE'];
|
||||
{$define FPC_SYSTEM_HAS_FPC_SET_IN_BYTE}
|
||||
function fpc_set_in_byte(const p: fpc_normal_set; b : byte): boolean;compilerproc;assembler;
|
||||
{
|
||||
tests if the element b is in the set p, the **zero** flag is cleared if it's present
|
||||
|
||||
@ -319,7 +320,7 @@ asm
|
||||
sub. r0,r0,r10
|
||||
bdnzt cr0*4+eq,LMCOMPSETS1
|
||||
cntlzw r3,r0
|
||||
srwi. r3,r3,31
|
||||
srwi. r3,r3,31
|
||||
end ['r0','r3','r4','r10','cr0','ctr'];
|
||||
|
||||
function fpc_set_contains_sets(const set1,set2: fpc_normal_set): boolean;assembler;[public,alias:'FPC_SET_CONTAINS_SETS']; compilerproc;
|
||||
@ -339,7 +340,7 @@ asm
|
||||
andc. r0,r0,r10
|
||||
bdnzt cr0*4+eq,LMCONTAINSSETS1
|
||||
cntlzw r3,r0
|
||||
srwi. r3,r3,31
|
||||
srwi. r3,r3,31
|
||||
end ['r0','r3','r4','r10','cr0','ctr'];
|
||||
|
||||
|
||||
@ -509,7 +510,11 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 2001-09-28 13:27:02 jonas
|
||||
Revision 1.11 2002-07-28 20:43:49 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.10 2001/09/28 13:27:02 jonas
|
||||
* use rlwnm instead of slw, because, although the programming
|
||||
environments manual states otherwise, slw uses the whole contents of
|
||||
the register instead of bits 27-31 as shift count (rlwnm doesn't)
|
||||
|
||||
23
rtl/powerpc/setjump.inc
Normal file
23
rtl/powerpc/setjump.inc
Normal file
@ -0,0 +1,23 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 2002 by Jonas Maebe and other members of the
|
||||
Free Pascal development team
|
||||
|
||||
SetJmp and LongJmp implementation for exception handling
|
||||
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2002-07-28 20:43:49 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
}
|
||||
@ -145,6 +145,8 @@ asm
|
||||
end['A0','D0'];
|
||||
{$endif m68k}
|
||||
{$ifndef fpc_getheapstart_ok}
|
||||
asm
|
||||
end;
|
||||
{$error Getheapstart code is not implemented }
|
||||
{$endif not fpc_getheapstart_ok}
|
||||
|
||||
@ -164,6 +166,8 @@ asm
|
||||
end ['D0'];
|
||||
{$endif m68k}
|
||||
{$ifndef fpc_getheapsize_ok}
|
||||
asm
|
||||
end;
|
||||
{$error Getheapsize code is not implemented }
|
||||
{$endif not fpc_getheapsize_ok}
|
||||
|
||||
@ -750,7 +754,7 @@ Begin
|
||||
IsLibrary := FALSE;
|
||||
StackBottom := Sptr - StackLength;
|
||||
{ Set up signals handlers }
|
||||
InstallSignals;
|
||||
InstallSignals;
|
||||
{ Setup heap }
|
||||
InitHeap;
|
||||
InitExceptions;
|
||||
@ -767,7 +771,11 @@ End.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.22 2002-05-31 13:37:24 marco
|
||||
Revision 1.23 2002-07-28 20:43:49 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.22 2002/05/31 13:37:24 marco
|
||||
* more Renamefest
|
||||
|
||||
Revision 1.21 2002/04/21 15:55:00 carl
|
||||
|
||||
@ -2619,7 +2619,11 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2002-03-01 12:42:42 peter
|
||||
Revision 1.5 2002-07-28 20:43:49 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.4 2002/03/01 12:42:42 peter
|
||||
* fixed HASINTF
|
||||
|
||||
Revision 1.3 2002/02/28 13:52:59 marco
|
||||
@ -2629,7 +2633,5 @@ end.
|
||||
* Merged objidl.idl translation. Most of wtypes.idl also included. Size slightly increased.
|
||||
|
||||
Revision 1.1 2001/08/19 21:02:02 florian
|
||||
* fixed and added a lot of stuff to get the Jedi DX( headers
|
||||
compiled
|
||||
|
||||
* fixed and added a lot of stuff to get the Jedi DX8 headers compiled
|
||||
}
|
||||
|
||||
@ -14,6 +14,9 @@
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
{$ifndef VER1_0}
|
||||
{ $define MT}
|
||||
{$endif VER1_0}
|
||||
unit {$ifdef VER1_0}SysWin32{$else}System{$endif};
|
||||
interface
|
||||
|
||||
@ -1564,7 +1567,11 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.28 2002-07-01 16:29:05 peter
|
||||
Revision 1.29 2002-07-28 20:43:49 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.28 2002/07/01 16:29:05 peter
|
||||
* sLineBreak changed to normal constant like Kylix
|
||||
|
||||
Revision 1.27 2002/06/04 09:25:14 pierre
|
||||
|
||||
@ -57,14 +57,14 @@ procedure init_threadvar(var offset : dword;size : dword);[public,alias: 'FPC_IN
|
||||
offset:=threadvarblocksize;
|
||||
inc(threadvarblocksize,size);
|
||||
end;
|
||||
|
||||
|
||||
type ltvInitEntry =
|
||||
record
|
||||
varaddr : pdword;
|
||||
size : longint;
|
||||
end;
|
||||
pltvInitEntry = ^ltvInitEntry;
|
||||
|
||||
|
||||
type
|
||||
ltvInitEntry = packed record
|
||||
varaddr : pdword;
|
||||
size : longint;
|
||||
end;
|
||||
pltvInitEntry = ^ltvInitEntry;
|
||||
|
||||
procedure init_unit_threadvars (tableEntry : pltvInitEntry);
|
||||
begin
|
||||
@ -80,10 +80,10 @@ type TltvInitTablesTable =
|
||||
count : dword;
|
||||
tables: array [1..32767] of pltvInitEntry;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
ThreadvarTablesTable : TltvInitTablesTable; external name 'FPC_LOCALTHREADVARTABLES';
|
||||
|
||||
|
||||
procedure init_all_unit_threadvars; [public,alias: 'FPC_INITIALIZELOCALTHREADVARS'];
|
||||
var i : integer;
|
||||
begin
|
||||
@ -98,7 +98,13 @@ end;
|
||||
function relocate_threadvar(offset : dword) : pointer;[public,alias: 'FPC_RELOCATE_THREADVAR'];
|
||||
|
||||
begin
|
||||
asm
|
||||
pushal
|
||||
end;
|
||||
relocate_threadvar:=TlsGetValue(dataindex)+offset;
|
||||
asm
|
||||
popal
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AllocateThreadVars;
|
||||
@ -135,8 +141,8 @@ procedure InitThread;
|
||||
{ we don't need to set the data to 0 because we did this with }
|
||||
{ the fillchar above, but it looks nicer }
|
||||
|
||||
{ ExceptAddrStack and ExceptObjectStack are threadvars }
|
||||
{ so every thread has its on exception handling capabilities }
|
||||
{ ExceptAddrStack and ExceptObjectStack are threadvars }
|
||||
{ so every thread has its own exception handling capabilities }
|
||||
InitExceptions;
|
||||
InOutRes:=0;
|
||||
// ErrNo:=0;
|
||||
@ -204,21 +210,33 @@ function BeginThread(ThreadFunction : tthreadfunc) : DWord;
|
||||
end;
|
||||
|
||||
function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : DWord;
|
||||
|
||||
var
|
||||
dummy : dword;
|
||||
|
||||
begin
|
||||
BeginThread:=BeginThread(nil,0,ThreadFunction,p,0,dummy);
|
||||
end;
|
||||
|
||||
function BeginThread(ThreadFunction : tthreadfunc;p : pointer;
|
||||
var ThreadId : DWord) : DWord;
|
||||
|
||||
begin
|
||||
BeginThread:=BeginThread(nil,0,ThreadFunction,p,0,ThreadId);
|
||||
end;
|
||||
|
||||
function BeginThread(ThreadFunction : tthreadfunc;p : pointer;
|
||||
var ThreadId : Longint) : DWord;
|
||||
begin
|
||||
BeginThread:=BeginThread(nil,0,ThreadFunction,p,0,DWord(ThreadId));
|
||||
end;
|
||||
|
||||
|
||||
function BeginThread(sa : Pointer;stacksize : dword;
|
||||
ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;
|
||||
var ThreadId : Longint) : DWord;
|
||||
begin
|
||||
BeginThread:=BeginThread(sa,stacksize,ThreadFunction,p,creationflags,DWord(threadid));
|
||||
end;
|
||||
|
||||
|
||||
procedure EndThread(ExitCode : DWord);
|
||||
|
||||
begin
|
||||
@ -250,7 +268,11 @@ procedure LeaveCriticalSection(var cs : TRTLCriticalSection);
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 2002-03-31 10:03:13 armin
|
||||
Revision 1.9 2002-07-28 20:43:50 florian
|
||||
* several fixes for linux/powerpc
|
||||
* several fixes to MT
|
||||
|
||||
Revision 1.8 2002/03/31 10:03:13 armin
|
||||
+ call to DoneThread was missing
|
||||
|
||||
Revision 1.7 2002/03/28 16:31:35 armin
|
||||
|
||||
@ -1,6 +1,5 @@
|
||||
//DLL Startup code for WIN32 port of FPK-Pascal 0.9.98
|
||||
//Written by P.Ozerski
|
||||
//16.10.1998
|
||||
// DLL Startup code for WIN32 port of Free Pascal
|
||||
// Written by P.Ozerski 16.10.1998
|
||||
.text
|
||||
.globl _mainCRTStartup
|
||||
_mainCRTStartup:
|
||||
@ -27,5 +26,10 @@ _WinMainCRTStartup:
|
||||
popl %ebx
|
||||
popl %ebp
|
||||
ret $12
|
||||
|
||||
|
||||
//
|
||||
// $Log$
|
||||
// Revision 1.3 2002-07-28 20:43:51 florian
|
||||
// * several fixes for linux/powerpc
|
||||
// * several fixes to MT
|
||||
//
|
||||
//
|
||||
|
||||
@ -1,6 +1,5 @@
|
||||
//Startup code for WIN32 port of FPK-Pascal 0.9.98
|
||||
//Written by P.Ozerski
|
||||
//1998
|
||||
//Startup code for WIN32 port of Free Pascal
|
||||
//Written by P.Ozerski 1998
|
||||
// modified by Pierre Muller
|
||||
.text
|
||||
.globl _mainCRTStartup
|
||||
@ -11,4 +10,11 @@ _mainCRTStartup:
|
||||
_WinMainCRTStartup:
|
||||
movb $0,U_SYSTEM_ISCONSOLE
|
||||
call _FPC_EXE_Entry
|
||||
|
||||
|
||||
//
|
||||
// $Log$
|
||||
// Revision 1.3 2002-07-28 20:43:51 florian
|
||||
// * several fixes for linux/powerpc
|
||||
// * several fixes to MT
|
||||
//
|
||||
//
|
||||
|
||||
Loading…
Reference in New Issue
Block a user