paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-21 11:41:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* removed assembler

Browse Source 
* cleanup
This commit is contained in:
peter 2003-12-24 22:27:13 +00:00
parent 6b3c925f64
commit d11cecb354
5 changed files with 507 additions and 1314 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

224
rtl/arm/typinfo.inc
View File

@ -1,224 +0,0 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2003 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.
**********************************************************************}
{ 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: }
{ a1: s }
{ a2: address }
{ a2: index }
{ a3: ivalue }
{ output: }
{ a1-a2: 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: }
{ a1: s }
{ a2: address }
{ a3: index }
{ a4: ivalue }
{ output: }
{ a1: 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: }
{ a1: s }
{ a2: address }
{ a3: index }
{ a4: ivalue }
{ output: }
{ f0: 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: }
{ a1: s }
{ a2: address }
{ a3: index }
{ a4: ivalue }
{ output: }
{ f0: 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: }
{ a1: s }
{ a2: address }
{ a3: index }
{ a4: ivalue }
{ output: }
{ f0: 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: }
{ a1: s }
{ a2: address }
{ a3: index }
{ a4: ivalue }
{ output: }
{ a1: 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: }
{ a1: address of shortstring result (temp) }
{ a2: s }
{ a3: address }
{ a4: index }
{ stack: ivalue }
{ stack: 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: }
{ a1: s }
{ a2: address }
{ a3: value (address of shortstring) }
{ a4: index }
{ stack: 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-11-30 19:48:20 florian
* fixed some arm stuff
}

163
rtl/i386/typinfo.inc
View File

@ -1,163 +0,0 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2001 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.
**********************************************************************}
{ 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;
asm
// ? Indexed Function
movl Index,%eax
testl %eax,%eax
je .LINoPush
movl IValue,%eax
pushl %eax
.LINoPush:
push s
// reset EDX for routines that return only EAX
xorl %edx,%edx
call Address
// now the result is in EDX:EAX
end;
Function CallIntegerProc(s : Pointer;Address : Pointer;Value : Integer; INdex,IValue : Longint) : Integer;assembler;
asm
// Push value to set
movl Value,%eax
pushl %eax
// ? Indexed Procedure
movl Index,%eax
testl %eax,%eax
je .LIPNoPush
movl IValue,%eax
pushl %eax
.LIPNoPush:
pushl s
call Address
end;
Function CallSingleFunc(s : Pointer; Address : Pointer;
Index, IValue : Longint) : Single; assembler;
asm
// ? Indexed Function
movl Index,%eax
testl %eax,%eax
je .LINoPush
movl IValue,%eax
pushl %eax
.LINoPush:
pushl s
call Address
//
end;
Function CallDoubleFunc(s : Pointer; Address : Pointer;
Index, IValue : Longint) : Double; assembler;
asm
// ? Indexed Function
movl Index,%eax
testl %eax,%eax
je .LINoPush
movl IValue,%eax
pushl %eax
.LINoPush:
pushl s
call Address
//
end;
Function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler;
asm
// ? Indexed Function
movl Index,%eax
testl %eax,%eax
je .LINoPush
movl IValue,%eax
pushl %eax
.LINoPush:
pushl s
call Address
//
end;
Function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler;
asm
// ? Indexed Function
movl Index,%eax
testl %eax,%eax
je .LBNoPush
movl IValue,%eax
pushl %eax
.LBNoPush:
pushl s
call Address
end;
// Assembler Functions can't have short stringreturn values.
// So we make a Procedure with var parameter.
// That's not true (FK)
Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint;
Var Res: Shortstring);assembler;
asm
// ? Indexed Function
movl Index,%eax
testl %eax,%eax
jnz .LSSNoPush
movl IValue,%eax
pushl %eax
// the result is stored in an invisible parameter
pushl Res
.LSSNoPush:
pushl s
call Address
end;
Procedure CallSStringProc(s : Pointer;Address : Pointer;Const Value : ShortString; INdex,IVAlue : Longint);assembler;
asm
// Push value to set
movl Value,%eax
pushl %eax
// ? Indexed Procedure
movl Index,%eax
testl %eax,%eax
// BUG 1 (jnz)
je .LSSPNoPush
movl IValue,%eax
pushl %eax
.LSSPNoPush:
// BUG 2 (push)
pushl s
call Address
end;
{
$Log$
Revision 1.6 2003-09-08 18:21:37 peter
* save edi,esi,ebx
Revision 1.5 2003/03/29 16:55:56 michael
+ Patch from Mattias Gaertner for single typeinfo
Revision 1.4 2002/09/07 16:01:19 peter
* old logs removed and tabs fixed
}

923
rtl/objpas/typinfo.pp
View File

File diff suppressed because it is too large Load Diff

241
rtl/powerpc/typinfo.inc
View File

@ -1,241 +0,0 @@
{
$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
}

270
rtl/sparc/typinfo.inc
View File

@ -1,270 +0,0 @@
{
$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
}