+ initial implementation, still needs changes for self pointer register

This commit is contained in:
Jonas Maebe 2001-10-28 14:08:37 +00:00
parent e02d95ed13
commit 50cd146e95

180
rtl/powerpc/typinfo.inc Normal file
View File

@ -0,0 +1,180 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Jonas Maebe,
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.
---------------------------------------------------------------------}
{$ASMMODE ATT}
Function CallIntegerFunc(s: Pointer; Address: Pointer; Index, IValue: LongInt): Int64; assembler;
{ input: }
{ r3: s }
{ r4: address }
{ r5: index }
{ r6: ivalue }
{ output: }
{ r3-r4: result }
asm
{ save current return address }
mflr r30
mtctr r4
{ always pass ivalue as second parameter, it doesn't matter if it }
{ isn't used }
mr r4,r6
bctrl
{ restore return address }
mtlr r30
end;
Function CallIntegerProc(s : Pointer;Address : Pointer;Value : Integer; INdex,IValue : Longint) : Integer;assembler;
{ input: }
{ r3: s }
{ r4: address }
{ r5: index }
{ r6: ivalue }
{ output: }
{ r3: result }
asm
{ save current return address }
mflr r30
mtctr r4
{ always pass ivalue as second parameter, it doesn't matter if it }
{ isn't used }
mr r4,r6
bctrl
{ restore return address }
mtlr r30
end;
Function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler;
{ input: }
{ r3: s }
{ r4: address }
{ r5: index }
{ r6: ivalue }
{ output: }
{ fr1: result }
asm
{ save current return address }
mflr r30
mtctr r4
{ always pass ivalue as second parameter, it doesn't matter if it }
{ isn't used }
mr r4,r6
bctrl
{ restore return address }
mtlr r30
end;
Function CallExtendedProc(s : Pointer;Address : Pointer;Value : Extended; INdex,IVAlue : Longint) : Integer;assembler;
{ input: }
{ r3: s }
{ r4: address }
{ fr3: value }
{ r7: index }
{ r8: ivalue }
{ output: }
{ r3: result }
asm
{ save current return address }
mflr r30
cmpli r7,0
mtctr r4
beq LNoIndex
fmr fr2,fr3
LNoIndex:
{ always pass ivalue as second parameter, it doesn't matter if it }
{ isn't used }
mr r4,r8
bctrl
{ restore return address }
mtlr r30
end;
Function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler;
{ input: }
{ r3: s }
{ r4: address }
{ r5: index }
{ r6: ivalue }
{ output: }
{ r3: result }
asm
{ save current return address }
mflr r30
mtctr r4
{ always pass ivalue as second parameter, it doesn't matter if it }
{ isn't used }
mr r4,r6
bctrl
{ restore return address }
mtlr r30
end;
Function CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint)
: Shortstring; assembler;
{ input: }
{ r3: address of shortstring result (temp) }
{ r4: s }
{ r5: address }
{ r6: index }
{ r7: ivalue }
{ output: }
{ r3: result }
asm
{ save current return address }
mflr r30
mtctr r5
{ always pass ivalue as second parameter, it doesn't matter if it }
{ isn't used }
mr r5,r7
bctrl
{ restore return address }
mtlr r30
end;
Procedure CallSStringProc(s : Pointer;Address : Pointer;Const Value : ShortString; INdex,IVAlue : Longint);assembler;
{ input: }
{ r3: s }
{ r4: address }
{ r5: value (address of shortstring) }
{ r6: index }
{ r7: ivalue }
{ output: }
{ none }
asm
{ save current return address }
mflr r30
mtctr r4
{ always pass ivalue as second parameter, it doesn't matter if it }
{ isn't used }
mr r4,r6
bctrl
{ restore return address }
mtlr r30
end;
{
$Log$
Revision 1.1 2001-10-28 14:08:37 jonas
+ initial implementation, still needs changes for self pointer register
Revision 1.3 2001/10/20 17:25:22 peter
}