mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-21 01:03:02 +02:00
242 lines
7.1 KiB
PHP
242 lines
7.1 KiB
PHP
{
|
|
$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.
|
|
---------------------------------------------------------------------}
|
|
|
|
Function CallIntegerFunc(s: Pointer; Address: Pointer; Index, IValue: LongInt): Int64; assembler;
|
|
{ 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;
|
|
{ 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;
|
|
{ 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;
|
|
{ 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;
|
|
{ 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;
|
|
{ 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;
|
|
{ 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;
|
|
{ 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.7 2003-04-24 12:28:47 jonas
|
|
* fixeed saving/restoring of return address
|
|
* synchronized with i386 version
|
|
|
|
Revision 1.6 2003/04/24 11:50:50 florian
|
|
* fixed assembling
|
|
|
|
Revision 1.5 2003/04/24 11:47:21 florian
|
|
* fixed wrong newlines
|
|
|
|
Revision 1.4 2003/04/23 22:47:13 florian
|
|
* fixed compilation
|
|
|
|
Revision 1.3 2003/04/23 22:19:21 peter
|
|
* sstringfunc para updated
|
|
|
|
Revision 1.2 2002/09/07 16:01:26 peter
|
|
* old logs removed and tabs fixed
|
|
|
|
}
|