mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2026-01-06 11:30:44 +01:00
* new dummies
This commit is contained in:
peter
parent
6264028af1
commit
1302e8e34c
@ -287,10 +287,31 @@ end{ ['R0','R3','F0','F1','F2','F3']};
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Int to real helpers
|
||||
****************************************************************************}
|
||||
|
||||
function fpc_int64_to_double(i: int64): double; compilerproc;
|
||||
begin
|
||||
{$warning FIXME}
|
||||
runerror(207);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function fpc_qword_to_double(q: qword): double; compilerproc;
|
||||
begin
|
||||
{$warning FIXME}
|
||||
runerror(207);
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2003-04-23 21:28:21 peter
|
||||
Revision 1.5 2003-09-01 20:46:32 peter
|
||||
* new dummies
|
||||
|
||||
Revision 1.4 2003/04/23 21:28:21 peter
|
||||
* fpc_round added, needed for int64 currency
|
||||
|
||||
Revision 1.3 2003/01/22 20:45:15 mazen
|
||||
|
||||
22
rtl/sparc/mathu.inc
Normal file
22
rtl/sparc/mathu.inc
Normal file
@ -0,0 +1,22 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1999-2000 by Florian Klaempfl
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2003-09-01 20:46:32 peter
|
||||
* new dummies
|
||||
|
||||
Revision 1.1 2003/04/24 09:14:22 florian
|
||||
* initial implementation
|
||||
}
|
||||
22
rtl/sparc/mathuh.inc
Normal file
22
rtl/sparc/mathuh.inc
Normal file
@ -0,0 +1,22 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1999-2000 by Florian Klaempfl
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2003-09-01 20:46:32 peter
|
||||
* new dummies
|
||||
|
||||
Revision 1.1 2003/04/24 09:14:22 florian
|
||||
* initial implementation
|
||||
}
|
||||
99
rtl/sparc/sysutilp.inc
Normal file
99
rtl/sparc/sysutilp.inc
Normal file
@ -0,0 +1,99 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
|
||||
Copyright (c) 2003 by Peter Vreman,
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
This include contains cpu-specific routines
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
function InterLockedDecrement (var Target: integer) : Integer; assembler;
|
||||
asm
|
||||
{$warning FIXME}
|
||||
end;
|
||||
(*
|
||||
{ input: address of target in r3 }
|
||||
{ output: target-1 in r3 }
|
||||
{ side-effect: target := target-1 }
|
||||
asm
|
||||
InterLockedDecLoop:
|
||||
lwarx r0,r0,r3
|
||||
subi r0,r0,1
|
||||
stwcx. r0,r0,r3
|
||||
bne InterLockedDecLoop
|
||||
mr r3,r0
|
||||
end;
|
||||
*)
|
||||
|
||||
|
||||
function InterLockedIncrement (var Target: integer) : Integer; assembler;
|
||||
asm
|
||||
{$warning FIXME}
|
||||
end;
|
||||
(*
|
||||
{ input: address of target in r3 }
|
||||
{ output: target+1 in r3 }
|
||||
{ side-effect: target := target+1 }
|
||||
asm
|
||||
InterLockedIncLoop:
|
||||
lwarx r0,r0,r3
|
||||
addi r0,r0,1
|
||||
stwcx. r0,r0,r3
|
||||
bne InterLockedIncLoop
|
||||
mr r3,r0
|
||||
end;
|
||||
*)
|
||||
|
||||
function InterLockedExchange (var Target: integer;Source : integer) : Integer; assembler;
|
||||
asm
|
||||
{$warning FIXME}
|
||||
end;
|
||||
(*
|
||||
{ input: address of target in r3, source in r4 }
|
||||
{ output: target in r3 }
|
||||
{ side-effect: target := source }
|
||||
asm
|
||||
InterLockedXchgLoop:
|
||||
lwarx r0,r0,r3
|
||||
stwcx. r4,r0,r3
|
||||
bne InterLockedXchgLoop
|
||||
mr r3,r0
|
||||
end;
|
||||
*)
|
||||
|
||||
|
||||
function InterLockedExchangeAdd (var Target: integer;Source : integer) : Integer; assembler;
|
||||
asm
|
||||
{$warning FIXME}
|
||||
end;
|
||||
(*
|
||||
{ input: address of target in r3, source in r4 }
|
||||
{ output: target in r3 }
|
||||
{ side-effect: target := target+source }
|
||||
asm
|
||||
InterLockedXchgAddLoop:
|
||||
lwarx r0,r0,r3
|
||||
add r0,r0,r4
|
||||
stwcx. r0,r0,r3
|
||||
bne InterLockedXchgAddLoop
|
||||
sub r3,r0,r4
|
||||
end;
|
||||
*)
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2003-09-01 20:46:32 peter
|
||||
* new dummies
|
||||
|
||||
}
|
||||
270
rtl/sparc/typinfo.inc
Normal file
270
rtl/sparc/typinfo.inc
Normal file
@ -0,0 +1,270 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
|
||||
Copyright (c) 2003 by Peter Vreman,
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{ This unit provides the same Functionality as the TypInfo Unit }
|
||||
{ of Delphi }
|
||||
{ ---------------------------------------------------------------------
|
||||
This include contains cpu-specific Low-level calling of methods.
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Function CallIntegerFunc(s: Pointer; Address: Pointer; Index, IValue: LongInt): Int64; assembler;
|
||||
asm
|
||||
{$warning FIXME}
|
||||
end;
|
||||
(*
|
||||
{ input: }
|
||||
{ r3: s }
|
||||
{ r4: address }
|
||||
{ r5: index }
|
||||
{ r6: ivalue }
|
||||
{ output: }
|
||||
{ r3-r4: result }
|
||||
var
|
||||
oldlr: pointer;
|
||||
asm
|
||||
{ save current return address }
|
||||
mflr r0
|
||||
stw r0,oldlr
|
||||
mtctr r4
|
||||
{ always pass ivalue as second parameter, it doesn't matter if it }
|
||||
{ isn't used }
|
||||
mr r4,r6
|
||||
bctrl
|
||||
{ restore return address }
|
||||
lwz r0,oldlr
|
||||
mtlr r0
|
||||
end;
|
||||
*)
|
||||
|
||||
Function CallIntegerProc(s : Pointer;Address : Pointer;Value : Integer; Index,IValue : Longint) : Integer;assembler;
|
||||
asm
|
||||
{$warning FIXME}
|
||||
end;
|
||||
(*
|
||||
{ input: }
|
||||
{ r3: s }
|
||||
{ r4: address }
|
||||
{ r5: index }
|
||||
{ r6: ivalue }
|
||||
{ output: }
|
||||
{ r3: result }
|
||||
var
|
||||
oldlr: pointer;
|
||||
asm
|
||||
{ save current return address }
|
||||
mflr r0
|
||||
stw r0,oldlr
|
||||
mtctr r4
|
||||
{ always pass ivalue as second parameter, it doesn't matter if it }
|
||||
{ isn't used }
|
||||
mr r4,r6
|
||||
bctrl
|
||||
{ restore return address }
|
||||
lwz r0,oldlr
|
||||
mtlr r0
|
||||
end;
|
||||
*)
|
||||
|
||||
|
||||
Function CallSingleFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Single;assembler;
|
||||
asm
|
||||
{$warning FIXME}
|
||||
end;
|
||||
(*
|
||||
{ input: }
|
||||
{ r3: s }
|
||||
{ r4: address }
|
||||
{ r5: index }
|
||||
{ r6: ivalue }
|
||||
{ output: }
|
||||
{ fr1: result }
|
||||
var
|
||||
oldlr: pointer;
|
||||
asm
|
||||
{ save current return address }
|
||||
mflr r0
|
||||
stw r0,oldlr
|
||||
mtctr r4
|
||||
{ always pass ivalue as second parameter, it doesn't matter if it }
|
||||
{ isn't used }
|
||||
mr r4,r6
|
||||
bctrl
|
||||
{ restore return address }
|
||||
lwz r0,oldlr
|
||||
mtlr r0
|
||||
end;
|
||||
*)
|
||||
|
||||
|
||||
Function CallDoubleFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Double;assembler;
|
||||
asm
|
||||
{$warning FIXME}
|
||||
end;
|
||||
(*
|
||||
{ input: }
|
||||
{ r3: s }
|
||||
{ r4: address }
|
||||
{ r5: index }
|
||||
{ r6: ivalue }
|
||||
{ output: }
|
||||
{ fr1: result }
|
||||
var
|
||||
oldlr: pointer;
|
||||
asm
|
||||
{ save current return address }
|
||||
mflr r0
|
||||
stw r0,oldlr
|
||||
mtctr r4
|
||||
{ always pass ivalue as second parameter, it doesn't matter if it }
|
||||
{ isn't used }
|
||||
mr r4,r6
|
||||
bctrl
|
||||
{ restore return address }
|
||||
lwz r0,oldlr
|
||||
mtlr r0
|
||||
end;
|
||||
*)
|
||||
|
||||
|
||||
Function CallExtendedFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Extended;assembler;
|
||||
asm
|
||||
{$warning FIXME}
|
||||
end;
|
||||
(*
|
||||
{ input: }
|
||||
{ r3: s }
|
||||
{ r4: address }
|
||||
{ r5: index }
|
||||
{ r6: ivalue }
|
||||
{ output: }
|
||||
{ fr1: result }
|
||||
var
|
||||
oldlr: pointer;
|
||||
asm
|
||||
{ save current return address }
|
||||
mflr r0
|
||||
stw r0,oldlr
|
||||
mtctr r4
|
||||
{ always pass ivalue as second parameter, it doesn't matter if it }
|
||||
{ isn't used }
|
||||
mr r4,r6
|
||||
bctrl
|
||||
{ restore return address }
|
||||
lwz r0,oldlr
|
||||
mtlr r0
|
||||
end;
|
||||
*)
|
||||
|
||||
|
||||
Function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler;
|
||||
asm
|
||||
{$warning FIXME}
|
||||
end;
|
||||
(*
|
||||
{ input: }
|
||||
{ r3: s }
|
||||
{ r4: address }
|
||||
{ r5: index }
|
||||
{ r6: ivalue }
|
||||
{ output: }
|
||||
{ r3: result }
|
||||
var
|
||||
oldlr: pointer;
|
||||
asm
|
||||
{ save current return address }
|
||||
mflr r0
|
||||
stw r0,oldlr
|
||||
mtctr r4
|
||||
{ always pass ivalue as second parameter, it doesn't matter if it }
|
||||
{ isn't used }
|
||||
mr r4,r6
|
||||
bctrl
|
||||
{ restore return address }
|
||||
lwz r0, oldlr
|
||||
mtlr r0
|
||||
end;
|
||||
*)
|
||||
|
||||
|
||||
Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint;
|
||||
Var Res: Shortstring);assembler;
|
||||
asm
|
||||
{$warning FIXME}
|
||||
end;
|
||||
(*
|
||||
{ input: }
|
||||
{ r3: address of shortstring result (temp) }
|
||||
{ r4: s }
|
||||
{ r5: address }
|
||||
{ r6: index }
|
||||
{ r7: ivalue }
|
||||
{ r8: res }
|
||||
{ output: }
|
||||
{ none }
|
||||
var
|
||||
oldlr: pointer;
|
||||
asm
|
||||
{ save current return address }
|
||||
mflr r0
|
||||
stw r0,oldlr
|
||||
mtctr r5
|
||||
{ always pass ivalue as second parameter, it doesn't matter if it }
|
||||
{ isn't used }
|
||||
mr r5,r7
|
||||
bctrl
|
||||
{ restore return address }
|
||||
lwz r0,oldlr
|
||||
mtlr r0
|
||||
end;
|
||||
*)
|
||||
|
||||
|
||||
Procedure CallSStringProc(s : Pointer;Address : Pointer;Const Value : ShortString; INdex,IVAlue : Longint);assembler;
|
||||
asm
|
||||
{$warning FIXME}
|
||||
end;
|
||||
(*
|
||||
{ input: }
|
||||
{ r3: s }
|
||||
{ r4: address }
|
||||
{ r5: value (address of shortstring) }
|
||||
{ r6: index }
|
||||
{ r7: ivalue }
|
||||
{ output: }
|
||||
{ none }
|
||||
var
|
||||
oldlr: pointer;
|
||||
asm
|
||||
{ save current return address }
|
||||
mflr r0
|
||||
stw r0,oldlr
|
||||
mtctr r4
|
||||
{ always pass ivalue as second parameter, it doesn't matter if it }
|
||||
{ isn't used }
|
||||
mr r4,r6
|
||||
bctrl
|
||||
{ restore return address }
|
||||
lwz r0,oldlr
|
||||
mtlr r0
|
||||
end;
|
||||
*)
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2003-09-01 20:46:32 peter
|
||||
* new dummies
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user